From 6f5785eb4e7a050c0c67aea79978fec6efc92b0e Mon Sep 17 00:00:00 2001 From: felipe-treistman Date: Mon, 11 Mar 2024 17:32:32 -0300 Subject: [PATCH 1/8] ajuste na validacao de previsao nova --- R/leitura_nova.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/leitura_nova.R b/R/leitura_nova.R index 1053271..df128f4 100644 --- a/R/leitura_nova.R +++ b/R/leitura_nova.R @@ -210,7 +210,7 @@ le_precipitacao_prevista <- function(arq) { for (idata in 1:dat[, length(unique(data_rodada))]) { data <- dat[, unique(data_rodada)[idata]] datas_previstas <- dat[data_rodada == data, unique(data_previsao)] - teste <- dat[data_rodada == data, setdiff(datas_previstas, data_previsao), by = c( "nome", "cenario")] + teste <- dat[data_rodada == data, setdiff(datas_previstas, data_previsao), by = c("nome", "cenario", "data_rodada")] teste_completo <- data.table::rbindlist(list(teste_completo, teste)) } From 8a01f54d94a8e4f249bf917a7ae07a945ab00d63 Mon Sep 17 00:00:00 2001 From: felipe-treistman Date: Tue, 12 Mar 2024 13:10:08 -0300 Subject: [PATCH 2/8] ajuste leitura modelos_precipitacao.txt --- R/leitura_antiga.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/leitura_antiga.R b/R/leitura_antiga.R index 758a47f..3ac317a 100644 --- a/R/leitura_antiga.R +++ b/R/leitura_antiga.R @@ -473,8 +473,9 @@ le_entrada_modelos_precipitacao <- function(pasta_entrada) { stop("nao existe o arquivo do tipo modelos_precipitacao.txt") } - dat <- data.table::as.data.table(read.csv(arq, header = FALSE, comment.char = "'", fill = TRUE)) + dat <- fread(arq, header = FALSE, blank.lines.skip = TRUE, sep = ";") dat[, V1 := tolower(V1)] + dat[, V1 := strsplit(V1, split = "'")[[1]][1], by = V1] numero_cenarios <- as.numeric(dat[1, V1]) if (is.na(numero_cenarios)) stop("Valor nao numerico de cenarios no arquivo modelos_precipitacao.txt") From 2ff324940b7529495e89d5505f5ba8819229ef4d Mon Sep 17 00:00:00 2001 From: felipe-treistman Date: Tue, 12 Mar 2024 15:10:02 -0300 Subject: [PATCH 3/8] ajuste leitura modelos_precipitacao.txt --- R/leitura_antiga.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/leitura_antiga.R b/R/leitura_antiga.R index 3ac317a..8eca60a 100644 --- a/R/leitura_antiga.R +++ b/R/leitura_antiga.R @@ -473,7 +473,7 @@ le_entrada_modelos_precipitacao <- function(pasta_entrada) { stop("nao existe o arquivo do tipo modelos_precipitacao.txt") } - dat <- fread(arq, header = FALSE, blank.lines.skip = TRUE, sep = ";") + dat <- data.table::fread(arq, header = FALSE, blank.lines.skip = TRUE, sep = ";") dat[, V1 := tolower(V1)] dat[, V1 := strsplit(V1, split = "'")[[1]][1], by = V1] numero_cenarios <- as.numeric(dat[1, V1]) From f25d9ff1a15a95d7496573cceccd4c2841afecd7 Mon Sep 17 00:00:00 2001 From: felipe-treistman Date: Tue, 12 Mar 2024 16:17:59 -0300 Subject: [PATCH 4/8] ajuste leitura modelos_precipitacao.txt e _parametros.txt --- R/leitura_antiga.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/leitura_antiga.R b/R/leitura_antiga.R index 8eca60a..f20bef8 100644 --- a/R/leitura_antiga.R +++ b/R/leitura_antiga.R @@ -20,7 +20,9 @@ le_entrada_parametros <- function(pasta_entrada, nome_subbacia) { stop(paste0("nao existe o arquivo ", pattern)) } - parametros <- read.csv(arq, comment.char = "'", header = FALSE, sep = ";") + parametros <- data.table::fread(arq, header = FALSE, blank.lines.skip = TRUE, sep = ";") + parametros[, V1 := iconv(V1, to = "UTF-8", sub = "�")] + parametros[, V1 := strsplit(V1, split = "'")[[1]][1], by = V1] parametros_smap <- array(rep(0, 82), c(1, 82)) parametros_smap <- data.table::data.table(parametros_smap) @@ -31,8 +33,8 @@ le_entrada_parametros <- function(pasta_entrada, nome_subbacia) { aux <- strsplit(arq, split = "/")[[1]] parametros_smap$nome <- tolower(sub(".*/", "", sub("_parametros.txt", "", nome_subbacia))) parametros_smap$Area <- as.numeric(parametros[1, 1]) - if (!is.character(parametros[2, 1])) stop(paste0("Nao existe valores de kt declarados no arquivo ", arq)) - aux <- unlist(strsplit(parametros[2, 1], "\\s+")) + if (!is.character(parametros[2, V1])) stop(paste0("Nao existe valores de kt declarados no arquivo ", arq)) + aux <- unlist(strsplit(parametros[2, V1], "\\s+")) parametros_smap$nKt <- as.numeric(aux[1]) if (is.na(parametros_smap$nKt)) stop(paste0("Parametro de numero de kt com valor nao numerico no arquivo ", arq)) if(as.numeric(aux[1]) != length(aux) - 1) stop(paste0("Numero de kt diferente do total de kt declarado no arquivo ", arq)) @@ -43,7 +45,7 @@ le_entrada_parametros <- function(pasta_entrada, nome_subbacia) { } for (iparametro in 67:80) { - parametros_smap[1, iparametro] <- as.numeric(parametros[(iparametro - 64), 1]) + parametros_smap[1, iparametro] <- as.numeric(parametros[(iparametro - 64), V1]) } parametros_smap[1, 81] <- sum(parametros_smap[, 7:66] > 0) @@ -474,6 +476,7 @@ le_entrada_modelos_precipitacao <- function(pasta_entrada) { } dat <- data.table::fread(arq, header = FALSE, blank.lines.skip = TRUE, sep = ";") + dat[, V1 := iconv(V1, to = "UTF-8", sub = "�")] dat[, V1 := tolower(V1)] dat[, V1 := strsplit(V1, split = "'")[[1]][1], by = V1] numero_cenarios <- as.numeric(dat[1, V1]) From b850da4898833d43b126bd4e24c233f2202f72b6 Mon Sep 17 00:00:00 2001 From: felipe-treistman Date: Thu, 14 Mar 2024 09:07:09 -0300 Subject: [PATCH 5/8] ajuste leitura modelos_precipitacao.txt e _parametros.txt --- R/leitura_antiga.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/leitura_antiga.R b/R/leitura_antiga.R index f20bef8..e24f18f 100644 --- a/R/leitura_antiga.R +++ b/R/leitura_antiga.R @@ -21,7 +21,7 @@ le_entrada_parametros <- function(pasta_entrada, nome_subbacia) { } parametros <- data.table::fread(arq, header = FALSE, blank.lines.skip = TRUE, sep = ";") - parametros[, V1 := iconv(V1, to = "UTF-8", sub = "�")] + parametros[, V1 := iconv(V1, "ASCII", "UTF-8", sub = "")] parametros[, V1 := strsplit(V1, split = "'")[[1]][1], by = V1] parametros_smap <- array(rep(0, 82), c(1, 82)) @@ -476,9 +476,10 @@ le_entrada_modelos_precipitacao <- function(pasta_entrada) { } dat <- data.table::fread(arq, header = FALSE, blank.lines.skip = TRUE, sep = ";") - dat[, V1 := iconv(V1, to = "UTF-8", sub = "�")] - dat[, V1 := tolower(V1)] + dat[, V1 := iconv(V1, "ASCII", "UTF-8", sub = "")] dat[, V1 := strsplit(V1, split = "'")[[1]][1], by = V1] + dat[, V1 := tolower(V1)] + dat[, V1 := trimws(V1)] numero_cenarios <- as.numeric(dat[1, V1]) if (is.na(numero_cenarios)) stop("Valor nao numerico de cenarios no arquivo modelos_precipitacao.txt") @@ -1054,4 +1055,4 @@ le_arq_entrada <- function(pasta_entrada) { datas_rodadas = datas_rodadas, caso = caso) saida -} +} \ No newline at end of file From 177aaf0e54c0ae30316408f9ca3abe315a98f961 Mon Sep 17 00:00:00 2001 From: felipe-treistman Date: Thu, 14 Mar 2024 11:53:48 -0300 Subject: [PATCH 6/8] Validacao arquivo de previsao / criacao de arquivo com funcoes de validacao de entrada --- NAMESPACE | 2 + R/leitura_nova.R | 1 + R/validacao_entrada.R | 67 ++++++++++++++++++++ inst/extdata/validacao_arq_entrada_novo.zip | Bin 25260796 -> 25264589 bytes man/valida_cenarios.Rd | 31 +++++++++ man/valida_previsao_etp.Rd | 30 +++++++++ tests/testthat/test-leitura_nova.R | 7 +- 7 files changed, 136 insertions(+), 2 deletions(-) create mode 100644 R/validacao_entrada.R create mode 100644 man/valida_cenarios.Rd create mode 100644 man/valida_previsao_etp.Rd diff --git a/NAMESPACE b/NAMESPACE index 80a0b9d..3730b5c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -63,6 +63,8 @@ export(rodada_varios_dias) export(totaliza_previsao) export(transforma_NC_serie) export(transforma_historico_previsao) +export(valida_cenarios) +export(valida_previsao_etp) importFrom(DT,dataTableOutput) importFrom(DT,renderDataTable) importFrom(arrow,read_parquet) diff --git a/R/leitura_nova.R b/R/leitura_nova.R index df128f4..00e48ec 100644 --- a/R/leitura_nova.R +++ b/R/leitura_nova.R @@ -679,6 +679,7 @@ le_arq_entrada_novo <- function(pasta_entrada) { if (!all(sub_bacias$nome %in% evapotranspiracao_prevista$nome)) { stop(paste0("Falta a sub-bacia ", sub_bacias[!nome %in% evapotranspiracao_prevista$nome, nome], " no arquivo ", arquivos[arquivo == "EVAPOTRANSPIRACAO_PREVISTA", nome_arquivo], ".\n")) } + valida_previsao_etp(evapotranspiracao_prevista, precipitacao_prevista) } else { warning("nao existe arquivo de previsao de evapotranspiracao, serao utilizados dados historicos") diff --git a/R/validacao_entrada.R b/R/validacao_entrada.R new file mode 100644 index 0000000..909c896 --- /dev/null +++ b/R/validacao_entrada.R @@ -0,0 +1,67 @@ +# VALIDACAO DE ENTRADA + +#' valida_previsao_etp +#' +#' Validador de arquivo de previsao de etp +#' +#' @param evapotranspiracao_prevista data.table com a evapotranspiracao prevista com as colunas +#' \itemize{ +#' \item{data_rodada - data da rodada do modelo que gerou a previsao} +#' \item{data_previsao - data da previsao} +#' \item{cenario - codigo do cenario} +#' \item{nome - nome da sub bacia} +#' \item{valor - valor da previsao de precipitacao} +#' } +#' @param precipitacao_prevista data.table com a precipitacao prevista com as colunas +#' \itemize{ +#' \item{data_rodada - data da rodada do modelo que gerou a previsao} +#' \item{data_previsao - data da previsao} +#' \item{cenario - codigo do cenario} +#' \item{nome - nome da sub bacia} +#' \item{valor - valor da previsao de precipitacao} +#' } +#' @export +valida_previsao_etp <- function(evapotranspiracao_prevista, precipitacao_prevista) { + + valida_cenarios(evapotranspiracao_prevista, precipitacao_prevista) +} + +#' valida_cenarios +#' +#' Valida se para cada valor unico de nome, data_previsao e data_rodada existem os mesmos +#' cenarios +#' +#' @param evapotranspiracao_prevista data.table com a evapotranspiracao prevista com as colunas +#' \itemize{ +#' \item{data_rodada - data da rodada do modelo que gerou a previsao} +#' \item{data_previsao - data da previsao} +#' \item{cenario - codigo do cenario} +#' \item{nome - nome da sub bacia} +#' \item{valor - valor da previsao de precipitacao} +#' } +#' @param precipitacao_prevista data.table com a precipitacao prevista com as colunas +#' \itemize{ +#' \item{data_rodada - data da rodada do modelo que gerou a previsao} +#' \item{data_previsao - data da previsao} +#' \item{cenario - codigo do cenario} +#' \item{nome - nome da sub bacia} +#' \item{valor - valor da previsao de precipitacao} +#' } +#' @export +valida_cenarios <- function(evapotranspiracao_prevista, precipitacao_prevista) { + + merged_data <- merge(precipitacao_prevista, evapotranspiracao_prevista, + by = c("data_previsao", "nome", "data_rodada", "cenario"), all = TRUE) + + if (nrow(merged_data[is.na(valor.x)]) != 0) { + stop(paste0("falta o cenario ", merged_data$cenario, " para a data de previsao ", + merged_data$data_previsao, " da sub-bacia ", merged_data$nome, + " do caso de ", merged_data$data_rodada, " no arquivo de previsao de precipitacao. \n")) + } + + if (nrow(merged_data[is.na(valor.y)]) != 0) { + stop(paste0("falta o cenario ", merged_data$cenario, " para a data de previsao ", + merged_data$data_previsao, " da sub-bacia ", merged_data$nome, + " do caso de ", merged_data$data_rodada, " no arquivo de previsao de evapotranspiracao. \n")) + } +} \ No newline at end of file diff --git a/inst/extdata/validacao_arq_entrada_novo.zip b/inst/extdata/validacao_arq_entrada_novo.zip index c1a1c891cd52903155a4845bc1a7c49d81e00b8c..a3bab7348f2663ecd2880f701a55ceac351f2c42 100644 GIT binary patch delta 4623 zcmb`Kd05Ts+Q-+!Mrcyeu+ylOG+9fuwjwIEXw`1o8%cAKR4WY{{lZ-uo;1*mcDu5$ z*^#9b=|!Cs(SVh)H=QCWqCxZfu#dyO&h{SXz21NB-|zc;zxRFpu5~@v`aI8gXN+*e z{#fB?Krjua!*?(PX2L8Gg4r+!=7KPYfGCK8ILreHkOV214+}sVWIz_=;CqmVg`fb6 zpajaG0;;eG)PN4^uoyI8321^AXoC*u!ct%W6PAG9Iyl{_z|qZ25i9&?BOT)88*Tu*bEM^1sq{3IDs>`fGfCx zJ9vO6c)>Q<4&JZ>d|)T|f*<$;7Xn}x1VRu5LkR4KPzZx?h=53lf;~V%H0*_auparf3f@HeQ1 z8&C)Ja1(Ap1Kfr?&4nGgjXYMgzy@K*CK3;unEGZ2(Lrf3}JJG*$A&kcmu)~ z2y+m&MA!=99}%`j*al%+gzXTvNBAd%e@1vC!kZA@jIaa3TM%|ccq_tA2sT-Jhp<1wT!aG<-i2@=!a)cJBOHS8ZiGV- z4nsH`;Ru8y5spH555g3>9E}t@GLuSegr+-g^vgWD)?QwdscUU9{W~cdjV45k+~~LI zj>`*?tutvfFEbiVldPIpF<81L_6(K|Bd^JNFOs6TyF5d@1A|<3+yg_7wl*a^ULh6T zK4$FfsX39Rl^d3|bkUZIl!gq;^-fhznfC{qWY<4mqcgL_s5$iD88NDSDtKyOa;S5% zbC1F5sgcR?j?S@(-l5*!!I7bnkw+5~oxMXHlY_kz0%zlK-zoFB{sr$}cTCj28|!%| zFzPFNPTeUsqNb$$yHEaod2zt(PPrmKdy`*m-73w>B|CW+3XixsX872zv%x{h7g;iQmf79bP&JeE7i|=eTP6JlS~3lo7P?Vf~e> z+Fd>O63;32ZrQKxSY=musnT(EmvRwV+aKRrS|V0M?OIsSnirR{xkqASfbyth>h&DA z*}1Jwl*)Zu+lRB>j2hHTnpVq|m86#W@Q14G8WeZi)d@}*&C`HQffAaGthlp3{d)0P zbze=Qvi6wNy`ElEN~x67s-IciXS=(IFZQZbso-(a%Z!YQn9h~O1G7{*gOf`a>r^)< z)n8$seoOiBhKik*^z4y+IjG>V&@ql*%nw+&YIOR!LSIkCD?L(0jn3YinHKX+j=4?U zZsqB8`Bpx)QdI0-XA!Sx#0_i?`qgpCO}UK6NAxPUQFQQ>>OX9U!6SbNBkx@&8g^=iDT0x6>QT| zV~JGG=CFwrC2}8;O4%GCA}3SpU=NXbD`e|=ma%=_)S>)v59W$wEqb-;q1mr*co-Y_ zGWk}y!bL4~ljr<8>mPiXdIvdlAZ{CR^&OaJEpvrE3l^ygh`XG)NgTQ7CG?b?ZQCpUlArkuu$B?OC^PZ^-dvb)A>ipmN%?8lT>? zGrZ0yIGV24#Kqp*)Ee~U_diUOy2r&kwngOlT&%fjy11lWM({ModgpcRA$8*x5uP8P zJuJfWA7D$0^0))+Wum-*0k)keZx^2(EXoVyn`Mgfg81w*QC={gEfD2}46xsc@^+KF z7%!CM#du*PFGlgg2iSpPya+x!Q;Zi$8pL=}q(O|gM`7I=iZxMSo)gWo%5f@`iECLC zUZ@e*QP>@&UbFUyXtT;zV|jH;|A>Sb5_mc!B@%E%?p&vW?Pj&czhLqA=JHJhhJNetT6G|O3r_tztrW7;tsyoP0|Bg&$)$d>6 z!aybIx$Wk14YEDgo%^O98&y_Cl~d(y2dk#`P?P;{CniJ2hK5EX$HvEdCnw*Aj0H@M z4o!~vD^H%AQmqc1J3jhuvSVaoaHPk1_|d!Pf;?(ZLfL@*+Z+LP5q2fn>Yq}!);Q-> z@HqZ$i-WBdL+9r5B}Y#f#-x>A?o9c;sd;OBaNE<8`=LoYjOt@1j5hXX-=FOEEy}34 zKPcz>B;B~R-eLHjj*ak>^wJW4ZsJIIIAf?F%I9oM&$fi1vdo*chJ`_^Dp^@^zM5m! zS^`GGM7&V;1)YHTv#6%LIQjch7OmAoqmt(`(wbLC3tnpssjJ+-n4WZbYr%!7>>ZQu zm#0T25rP@VEmuD$u|HmDi&}!DdWe{AEdQ0AeX)@`fr{s~E9HwqGAlHTqFl;m$aebK zm+|jvYYD=NjKnpHBlznA#4YrfjH#TfcQ&{{g`Ye<#<<(#pF#z5#l4-qJ647d%yL`* zsD5>%Kx0FGRdb0)#*$dWnn_*vyo#){!O_6c_lKPLhu`vJPNA$^zrGj}kq+Y;C^u)3u`^o+NUU(NxW2mU#Shl0~CuJWNGEHq9(Qu*0o?9p$G zza1`lf2`Ecez>>~NAfxwm zVRo#$bwui~atCdCcm5bCQpU;>TDL;JKPS+ZU`caC|o zUI$l>)K2aa^F;gS+?D1&LEYR9=7~W)TnAEnxjTsanj21PKR1EYcibFO2f3$69p+Y$ z%m}yMoJtHD<31!}g8TBh&E3%hEk@ymv*S9Bcdtv>%MvLx&)LWF%XzxZR=&DhNxNCC zI-q5sl(*?a!1u={@mkB4cqy>}N4=wFlJjcUwIoVO2IR1l_2vhhVkg;42UM^Vzq0ZE zaXO;@brXL+LVf!Q>cf&-)a=4V}2NG+BgF zl|28)(dOg%<{Qe=59gq7$bF7{*gyN~2}JiAFTq{{W6w+kyZ9 delta 935 zcmWN^XJ8Em0EN+akyx=4F_PFTF=Efyd&Wu-GxlDw65-*qFIuCeYP7UQ2c5L2(yiz) zTRI53+mx0LEjjJlVu_eGORG@>z0Xi77h(}DzA z(u&r!p)KubPX{{EiOzJPE8XZ$4|>vzM0(SQzVxF%NhC9Xfea#r!3<$2!x+v8QW?o8 zMl*)7jAJ|#n8+k1Gli*4V>&aKNgA`5%^c=3k90DaPbLdkNRUM=W(lyAWh`d}D_O;A z%o^6Rjz@Tu^=x1xn|O@J*~}K6U@K3ujqU7UCr|M-yV%V$Jj)*TvXA{d$Md|viyYt} zFYz+3@G7tII)^yS8@$O8j&h8*IL_Og;3V(xF7NR^AMha`af**Q%^A+}37_&ApL34$ zT;L*?xXc%P$rY~h6<_lW-*S!XWO0L=+~PaF=Lde|Cw}G^e&si^`JLO`;Sc`gF8BD0 zzxjuMxzB(6&w~}Rd-;MY)n(S*{{im8;3sRSFR`5 zmmA0pkKJW?JdkCw;CW94!3czJ?6 zQJy4EmZ!*5%v1q R1340vn3F&tDl4c!;2{Tzco+Zx diff --git a/man/valida_cenarios.Rd b/man/valida_cenarios.Rd new file mode 100644 index 0000000..63f1b67 --- /dev/null +++ b/man/valida_cenarios.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/validacao_entrada.R +\name{valida_cenarios} +\alias{valida_cenarios} +\title{valida_cenarios} +\usage{ +valida_cenarios(evapotranspiracao_prevista, precipitacao_prevista) +} +\arguments{ +\item{evapotranspiracao_prevista}{data.table com a evapotranspiracao prevista com as colunas +\itemize{ +\item{data_rodada - data da rodada do modelo que gerou a previsao} +\item{data_previsao - data da previsao} +\item{cenario - codigo do cenario} +\item{nome - nome da sub bacia} +\item{valor - valor da previsao de precipitacao} +}} + +\item{precipitacao_prevista}{data.table com a precipitacao prevista com as colunas +\itemize{ +\item{data_rodada - data da rodada do modelo que gerou a previsao} +\item{data_previsao - data da previsao} +\item{cenario - codigo do cenario} +\item{nome - nome da sub bacia} +\item{valor - valor da previsao de precipitacao} +}} +} +\description{ +Valida se para cada valor unico de nome, data_previsao e data_rodada existem os mesmos +cenarios +} diff --git a/man/valida_previsao_etp.Rd b/man/valida_previsao_etp.Rd new file mode 100644 index 0000000..72835a9 --- /dev/null +++ b/man/valida_previsao_etp.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/validacao_entrada.R +\name{valida_previsao_etp} +\alias{valida_previsao_etp} +\title{valida_previsao_etp} +\usage{ +valida_previsao_etp(evapotranspiracao_prevista, precipitacao_prevista) +} +\arguments{ +\item{evapotranspiracao_prevista}{data.table com a evapotranspiracao prevista com as colunas +\itemize{ +\item{data_rodada - data da rodada do modelo que gerou a previsao} +\item{data_previsao - data da previsao} +\item{cenario - codigo do cenario} +\item{nome - nome da sub bacia} +\item{valor - valor da previsao de precipitacao} +}} + +\item{precipitacao_prevista}{data.table com a precipitacao prevista com as colunas +\itemize{ +\item{data_rodada - data da rodada do modelo que gerou a previsao} +\item{data_previsao - data da previsao} +\item{cenario - codigo do cenario} +\item{nome - nome da sub bacia} +\item{valor - valor da previsao de precipitacao} +}} +} +\description{ +Validador de arquivo de previsao de etp +} diff --git a/tests/testthat/test-leitura_nova.R b/tests/testthat/test-leitura_nova.R index 24bbbe9..d877af6 100644 --- a/tests/testthat/test-leitura_nova.R +++ b/tests/testthat/test-leitura_nova.R @@ -198,8 +198,11 @@ test_that("testa precipitacao_prevista.csv", { arq <- system.file("extdata", "validacao_arq_entrada_novo", "CN18", "CT18.11", "Arq_Entrada", "precipitacao_prevista.csv", package = "smapOnsR") expect_error(suppressWarnings(le_precipitacao_prevista(arq))) - arq <- system.file("extdata", "validacao_arq_entrada_novo", "CN18", "CT18.12", "Arq_Entrada", "precipitacao_prevista.csv", package = "smapOnsR") - expect_error(suppressWarnings(le_precipitacao_prevista(arq))) + arq_prec <- system.file("extdata", "validacao_arq_entrada_novo", "CN18", "CT18.12", "precipitacao_prevista.csv", package = "smapOnsR") + arq_etp <- system.file("extdata", "validacao_arq_entrada_novo", "CN18", "CT18.12", "evapotranspiracao_prevista.csv", package = "smapOnsR") + precipitacao_prevista <- data.table::fread(arq_prec) + evapotranspiracao_prevista <- data.table::fread(arq_etp) + expect_error(valida_cenarios(evapotranspiracao_prevista, precipitacao_prevista)) }) test_that("testa vazoes.csv", { From 24345e8aafe51357eebc31e7b825d057c49cfb6d Mon Sep 17 00:00:00 2001 From: felipe-treistman Date: Thu, 14 Mar 2024 15:03:23 -0300 Subject: [PATCH 7/8] testa reproducao exata dos resultados --- tests/testthat/test-execucao.R | 5 ++- tests/testthat/test-rodadas_encadeadas.R | 47 ++++++++++++++++++------ 2 files changed, 39 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-execucao.R b/tests/testthat/test-execucao.R index 38962c8..05b857e 100644 --- a/tests/testthat/test-execucao.R +++ b/tests/testthat/test-execucao.R @@ -26,6 +26,7 @@ test_that("testa execucao oficial", { }) test_that("testa execucao novo formato", { + library(smapOnsR) pasta_entrada <- system.file("extdata", "arq_entrada_novo", package = "smapOnsR") saida <- suppressWarnings(executa_caso_novo(pasta_entrada)) @@ -33,9 +34,9 @@ test_that("testa execucao novo formato", { secao <- sessionInfo() if (secao$R.version$os == "mingw32") { - # expect_equal(round(saida$previsao[nome == "avermelha" & variavel == "Qcalc" & cenario == "historico", valor][27], 0), 730) + expect_equal(round(saida$previsao[nome == "avermelha" & variavel == "Qcalc" & cenario == "historico", valor][1], 2), 345.11) } else { - expect_true(abs(round(saida$previsao[nome == "avermelha" & variavel == "Qcalc" & cenario == "historico", valor][27], 0) - 730) < 730 * 0.01) + expect_true(abs(round(saida$previsao[nome == "avermelha" & variavel == "Qcalc" & cenario == "historico", valor][1], 2) - 345.11) < 345.11 * 0.01) } unlink(system.file("extdata", "Arq_Entrada", package = "smapOnsR"), recursive = TRUE) diff --git a/tests/testthat/test-rodadas_encadeadas.R b/tests/testthat/test-rodadas_encadeadas.R index 3d78526..175910f 100644 --- a/tests/testthat/test-rodadas_encadeadas.R +++ b/tests/testthat/test-rodadas_encadeadas.R @@ -44,10 +44,11 @@ test_that("testa rodadas encadeadas", { }) test_that("testa rodada ecmwf", { - zip::unzip(system.file("extdata", "dados_entrada.zip", package = "smapOnsR"), exdir = system.file("extdata", package = "smapOnsR")) + + library(smapOnsR) + zip::unzip(system.file("extdata", "dados_entrada.zip", package = "smapOnsR"), exdir = system.file("extdata", package = "smapOnsR")) pasta_entrada <- system.file("extdata", "Arq_Entrada", package = "smapOnsR") - #pasta_entrada <- "inst//extdata//Arq_Entrada" entrada <- le_arq_entrada(pasta_entrada) @@ -70,9 +71,15 @@ test_that("testa rodada ecmwf", { secao <- sessionInfo() if (secao$R.version$os == "mingw32") { - expect_equal(round(saida$previsao[nome == "pimentalt" & variavel == "Qcalc" & cenario == "ecmwf_1", valor][31], 0), 10166) + expect_equal(round(saida$previsao[nome == "pimentalt" & variavel == "Qcalc" & cenario == "ecmwf_1", valor][1], 2), 5146.59) + expect_equal(round(saida$funcao_objetivo[, funcao_objetivo], 7), + c(0.1107962, 0.0213238, 0.0015776, 0.0131814, 0.0576028, + 0.0356864, 0.0591549, 0.2446411, 0.0101129, 0.1188261, + 0.0006430, 0.0191476, 0.0005964, 0.0022157, 0.0355439, + 0.0281633, 0.0066142, 0.1009915, 0.0030379, 0.1092217, + 0.1348698, 0.0575809)) } else { - expect_true(abs(round(saida$previsao[nome == "pimentalt" & variavel == "Qcalc" & cenario == "ecmwf_1", valor][31], 0) - 10166) < 10166 * 0.01) + expect_true(abs(round(saida$previsao[nome == "pimentalt" & variavel == "Qcalc" & cenario == "ecmwf_1", valor][1], 0) - 5146.59) < 10166 * 0.01) } entrada$inicializacao[variavel == "ajusta_precipitacao", valor := 1] @@ -85,15 +92,21 @@ test_that("testa rodada ecmwf", { secao <- sessionInfo() if (secao$R.version$os == "mingw32") { - expect_equal(round(saida$previsao[nome == "tucurui" & variavel == "Qcalc" & cenario == "ecmwf_1", valor][1], 0), 2211) + expect_equal(round(saida$previsao[nome == "tucurui" & variavel == "Qcalc" & cenario == "ecmwf_1", valor][1], 2), 2210.95) + expect_equal(round(saida$funcao_objetivo[, funcao_objetivo], 7), + c(0.1107962, 0.0213238, 0.0015776, 0.0131814, 0.0576028, + 0.0356864, 0.0591549, 0.2446411, 0.0101129, 0.1188261, + 0.0006430, 0.0191476, 0.0005964, 0.0022157, 0.0355439, + 0.0281633, 0.0066142, 0.1009915, 0.0030379, 0.1092217, + 0.1348698, 0.0575809)) } else { - expect_true(abs(round(saida$previsao[nome == "tucurui" & variavel == "Qcalc" & cenario == "ecmwf_1", valor][1], 0) - 2211) < 2211 * 0.01) + expect_true(abs(round(saida$previsao[nome == "tucurui" & variavel == "Qcalc" & cenario == "ecmwf_1", valor][1], 2) - 2211) < 2210.95 * 0.01) } }) test_that("testa rodada ecmwf formato oficial", { + library(smapOnsR) pasta_entrada <- system.file("extdata", "Arq_Entrada1", package = "smapOnsR") - entrada <- le_arq_entrada(pasta_entrada) set.seed(129852) @@ -104,7 +117,13 @@ test_that("testa rodada ecmwf formato oficial", { secao <- sessionInfo() if (secao$R.version$os == "mingw32") { - expect_equal(round(saida$previsao[nome == "avermelha" & variavel == "Qcalc" & cenario == "ecmwf_ex42", valor][27], 0), 202) + expect_equal(round(saida$previsao[nome == "avermelha" & variavel == "Qcalc" & cenario == "ecmwf_ex42", valor][1], 2), 142.49) + expect_equal(round(saida$funcao_objetivo[, funcao_objetivo], 7), + c(0.7782175, 0.0500985, 0.1595498, 0.5419530, 0.6626864, + 2.4551763, 0.0663579, 0.0329327, 0.3964460, 0.3122717, + 0.3056500, 6.3627029, 0.2200111, 0.0826504, 0.3945530, + 0.0288400, 0.2675268, 7.2110025, 4.3542436, 0.0271068, + 0.0632389, 0.0582628)) } else { expect_true(abs(round(saida$previsao[nome == "avermelha" & variavel == "Qcalc" & cenario == "ecmwf_ex42", valor][27], 0) - 202) < 202 * 0.01) } @@ -112,7 +131,7 @@ test_that("testa rodada ecmwf formato oficial", { test_that("testa rodada oficial", { pasta_entrada <- system.file("extdata", "Arq_Entrada0", package = "smapOnsR") - + library(smapOnsR) entrada <- le_arq_entrada(pasta_entrada) set.seed(129852) @@ -123,9 +142,15 @@ test_that("testa rodada oficial", { secao <- sessionInfo() if (secao$R.version$os == "mingw32") { - expect_equal(round(saida$previsao[nome == "ssimao2" & variavel == "Qcalc", valor][17], 0), 1210) + expect_equal(round(saida$previsao[nome == "ssimao2" & variavel == "Qcalc", valor][1], 2), 1073.91) + expect_equal(round(saida$funcao_objetivo[, funcao_objetivo], 7), + c(0.0434298, 0.0378167, 0.0181129, 0.0120293, 0.0143889, + 0.0090646, 0.0205859, 0.1056197, 0.0083967, 0.0593502, + 0.0312499, 0.1302981, 0.0278158, 0.0511445, 0.0148080, + 0.0224452, 0.0298919, 0.0103037, 0.1422300, 0.0336895, + 0.1225972, 0.0513591)) } else { - expect_true(abs(round(saida$previsao[nome == "ssimao2" & variavel == "Qcalc", valor][17], 0) - 1210) < 1210 * 0.01) + expect_true(abs(round(saida$previsao[nome == "ssimao2" & variavel == "Qcalc", valor][1], 2) - 1073.91) < 1073.91 * 0.01) } }) From cbd01a215335f53a426c6485b16223a2ce08f8c0 Mon Sep 17 00:00:00 2001 From: felipe-treistman Date: Thu, 14 Mar 2024 15:32:36 -0300 Subject: [PATCH 8/8] documentacao / News e versao --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 21 +++++++++++++++++++++ R/assimilacao.R | 1 + R/rodadas_encadeadas.R | 2 ++ 5 files changed, 26 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1b2d27e..a752647 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: smapOnsR Title: SMAP/ONS -Version: 0.2.2 +Version: 0.3.0 Authors@R: person("Felipe", "Treistman", , "felipe.treistman@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-9948-8680")) diff --git a/NAMESPACE b/NAMESPACE index 3730b5c..e81a5fe 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -78,6 +78,7 @@ importFrom(data.table,setcolorder) importFrom(data.table,setnames) importFrom(data.table,setorder) importFrom(doParallel,registerDoParallel) +importFrom(funcaoSmapCpp,rodada_cenarios_dias_cpp2) importFrom(funcaoSmapCpp,rodada_varios_dias_cpp2) importFrom(future,future) importFrom(future,resolved) diff --git a/NEWS.md b/NEWS.md index e743a83..c347e55 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,24 @@ +# smapOnsR 0.3.0 + +## Major changes + +* Processo de calibração paralelizado + +## Minor changes + +* Ajuste na validacao de arquivo de inicializacao oficial, e de previsao nova + +* Inclusao de teste de validacao de previsao nova + +* Ajuste em arquivos exemplo + +* Ajuste na leitura de arquivo de precipitacao observada, "modelos_precipitacao" e "_parametros" oficial + +* Alteracao do teste das funcoes de rodadas_encadeadas + +* Criacao de arquivo com funcoes de validacao de dados de entrada (futuramente todas as validacoes de arquivos de entrada estará contida nesse arquivo) + + # smapOnsR 0.2.2 ## Bug fixes diff --git a/R/assimilacao.R b/R/assimilacao.R index 3ba5e82..4105431 100644 --- a/R/assimilacao.R +++ b/R/assimilacao.R @@ -218,6 +218,7 @@ assimilacao_oficial <- function(vetor_modelo, area, EbInic, TuInic, Supin, preci #' fo #' #' @importFrom data.table data.table +#' @importFrom funcaoSmapCpp rodada_varios_dias_cpp2 #' @return objetivo valor da funcao objetivo #' @export diff --git a/R/rodadas_encadeadas.R b/R/rodadas_encadeadas.R index 2e0e587..06288bc 100644 --- a/R/rodadas_encadeadas.R +++ b/R/rodadas_encadeadas.R @@ -53,6 +53,7 @@ #' } #' @param sub_bacias vetor com o nome das sub-bacias a serem consideradas #' @importFrom data.table data.table +#' @importFrom funcaoSmapCpp rodada_cenarios_dias_cpp2 #' @return saida lista com o data.table previsao contendo as seguintes colunas: #' \itemize{ #' \item{data_caso - data da rodada} @@ -349,6 +350,7 @@ rodada_encadeada_oficial <- function(parametros, inicializacao, precipitacao_obs #' } #' @param sub_bacias vetor com o nome das sub-bacias a serem consideradas #' @importFrom data.table data.table +#' @importFrom funcaoSmapCpp rodada_cenarios_dias_cpp2 #' @return saida lista com o data.table previsao contendo as seguintes colunas: #' \itemize{ #' \item{data_caso - data da rodada}