joari

readfile-V1.R

Dec 10th, 2018
212
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 4.61 KB | None | 0 0
  1. # ==================================================================================
  2. # r-script para testar ajuste de modelos PAR(p)
  3. # input: Energias medias mensais historicas para REEs (EAF_NE.csv, ...)
  4. # output: relatorio com ordens PAR(p) escolhida via AIC e BIC
  5. # Ref: Estacionaridade das energias afluentes aos REEs
  6. # ==================================================================================
  7. #
  8. # ***********************************************************************************************
  9. # Clean variables & Set working directory
  10. rm(list=ls());                     # limpa vari?veis
  11. # workdir <- "D:/ProjetosONS/Cursos/Alex/R-project/EAFs/2018/";          # diretorio de trabalho
  12. workdir <- file.path("D:", "ProjetosONS", "Cursos", "Alex", "R-project", "EAFs", "2018")
  13. # workdir <- file.path("/home", "joari", "ProjetosONS", "Cursos", "Alex", "R-project", "ENAs", "2018", "readtxt")
  14. setwd(workdir);
  15. # ***********************************************************************************************
  16. source("functions.R")
  17. source("readEAFh.R")
  18. #
  19. # ***********************************************************************************************
  20. #
  21. criterion <- "bic"
  22. for (iREE in 1:totREE) {
  23. # for (iREE in 8:8) {
  24.   print(paste0("iREE = ", iREE))
  25.   EAF <- EAFh[iREE,,2:13]
  26.   arquivo <- paste("EAF-", NameREE[[iREE]], "-", toupper(criterion), sep = "")
  27.   saida <- paste(arquivo, ".out", sep = "")
  28.   saida_Full <- paste(arquivo, "-Full.out", sep = "")
  29.   #
  30.   # ***********************************************************************************************
  31.   #
  32.   # fit parp (pear package), using library("pear")
  33.   maxEAF <- 1.05*max(EAF)
  34.   savePARp <- list()
  35.   cat(paste0("\n ", toupper(criterion), " model order\n", sep=""), file=saida, append=FALSE)
  36.   cat(paste0("\n ", toupper(criterion), " model order parameteres\n", sep=""), file=saida_Full, append=FALSE)
  37.   title <- paste(" Anoini Anofin   Total", paste(formatC(month.abb,format="s",width=6), collapse = " "), sep = "")
  38.   cat(title, file=saida, append=TRUE)
  39.   cases <- seq(1, 66, by = 5)
  40.   # for (inicio in cases){
  41.   for (i in 1:length(cases)){
  42.     anoini <- anoIni + cases[i] - 1
  43.     out <- paste("\n")
  44.     out <- paste(out,
  45.                  formatC(anoini, digits=0, format="f", width=6),
  46.                  formatC(anoFim, digits=0, format="f", width=6),
  47.                  formatC(anoFim - anoini + 1, digits=0, format="f", width=7), sep = " ")
  48.     cat(out, file=saida, append=TRUE)
  49.     cat(out, file=saida_Full, append=TRUE)
  50.     tmp <- EAF[cases[i]:totYears,]
  51.     plot_EAFh (tmp, maxEAF, anoIni, anoFim, arquivo, anoini)
  52.     # padronizando tmp
  53.     EAFpad <- scale(tmp)
  54.     savePARp[[i]] <- try(ajusta_parp (EAFpad, anoFim, criterion, saida, saida_Full), silent = TRUE)
  55.   }
  56.   #
  57.   aa   <- array(0, dim = c(length(cases), 12))
  58.   ymed <- array(0, dim = c(length(cases), 12))
  59.   ysup <- array(0, dim = c(length(cases), 12))
  60.   yinf <- array(0, dim = c(length(cases), 12))
  61.   minY <- 1.0
  62.   for (mes in 1:12) {
  63.     # get identified model order for each month (mes) for every sample size
  64.     for (i in seq(1,length(cases))) {
  65.       try({
  66.         if (is.numeric(savePARp[[i]][[1]][[mes]])) {aa[i, mes] <- savePARp[[i]][[1]][[mes]]}
  67.       })
  68.     }
  69.     cat(paste0("mes ", formatC(mes, digits=NULL,format="d",width=3)))
  70.     cat(formatC(aa[, mes], digits=NULL,format="d",width=3), sep="")
  71.     cat("\n")
  72.     if (all(aa[, mes] == 1, na.rm = TRUE)) {
  73.       print(paste0(month.abb[mes], " ordem 1 para todos os casos"))
  74.       for (i in seq(1,length(cases))) {
  75.         ymed[i, mes] <- savePARp[[i]][[2]][mes,1]
  76.         delta <- 1.96*savePARp[[i]][[3]][mes,1]/sqrt(anoFim - anoIni - cases[i] + 2)
  77.         ysup[i, mes] <- ymed[i, mes] + delta
  78.         yinf[i, mes] <- ymed[i, mes] - delta
  79.         minY <- min(minY, yinf[i, mes])
  80.       }
  81.     }
  82.   }
  83.   # Barplot for all modes with order == 1 for every month
  84.   anoI = (anoIni + cases - 1)
  85.   maxY <- 1
  86.   for (mes in 1:12) {
  87.     if (all(aa[, mes] == 1)) {
  88.       png(file=paste(arquivo, " - ", month.abb[mes],".png",sep=""));
  89.       phi_barplot <- barplot(ymed[, mes], names.arg = anoI, col=c("blue" , "skyblue") ,
  90.                              ylim = c(minY, maxY), xlab = "ano inicial", ylab = "Model order",
  91.                              main = paste(arquivo, " - ", month.abb[mes], sep = ""),
  92.                              xpd=FALSE)
  93.       axis(side = 1,at = phi_barplot, labels = FALSE)
  94.       arrows(phi_barplot, ysup[, mes], phi_barplot, yinf[, mes], angle = 90, code = 3, length = 0.1)
  95.       abline(h = 1, col = "blue", lwd = 2)
  96.       box(bty = "l")
  97.       dev.off();
  98.     }
  99.   }
  100.   plot_order(aa, cases, anoI, arquivo)
  101. }
Advertisement
Add Comment
Please, Sign In to add comment