===== Função obs.sim ===== obs.sim <- function(obs,sim,indice=c("all","r2","r","d","c","EM","EAM","REQM","EF")) #1 Cria função "obs.sim" com os argumentos "obs", "sim" e "indice". { ############################### ## Verificando as entradas ## ############################### if(any(is.na(obs) == TRUE)) #2 Verificando se existe dados faltantes no obs. {obs <- na.omit(obs)} #3 Se houver, exclui a(s) linha(s) em que houver dado(s) faltante(s). if(any(is.na(sim) == TRUE)) #4 Verificando se existe dados faltantes no sim. {sim <- na.omit(sim)} #5 Se houver, exclui a(s) linha(s) em que houver dado(s) faltante(s. if(class(obs) != "numeric" && "obs" >= 0) #6 Verificando o tipo de dado de entrada. { stop("obs precisa ser número e ≥ 0.") } #7 Caso não seja um numero ou seja menor que zero, retorna uma mensagem de erro. if(class(sim) != "data.frame" && "sim" >= 0) #8 Verificando o tipo de dado de entrada. { stop("sim precisa ser da classe data.frame e ≥ 0.") } #9 Caso não seja um data.frame ou seja menor que zero, retorna uma mensagem de erro. if(length(obs) != nrow(sim)) #10 Verificando se os dados obs e sim apresentam mesma quantidade de valores. { stop("obs e sim devem apresentar mesma quantidade de dados.") } #11 Caso obs e sim nao apresentem mesma quantidade de valores, retorna uma mensagem de erro. if(indice != "all" && indice != "r2" && indice != "r" && indice != "d" && indice != "c" #12 Verificando se houve erro de digitacao. && indice != "EM" && indice != "EAM" && indice != "REQM" && indice != "EF") #13 Verificando se houve erro de digitacao. { stop("indice pode ser all, r2, r, d, c, EM, EAM, REQM ou EF.") } #14 Caso haja erro de digitacao, retorna uma mensagem de erro. ########################################### ## Criando os parametros condicionais ### ########################################### if(indice == "all") #15 Se o usuario escolher todos os índices ("all"). { N <- ncol(sim) #16 Atribui a "N" o numero de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=10) #17 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("r2","r","Interpretacao r","d","c", #18 Atribui os nomes dos indices as linhas de "resultado". "Desempenho c","EM","EAM","REQM","EF") #19 Atribui os nomes dos indices as linhas de "resultado". colnames(resultado) = c(colnames(sim)) #20 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #21 Entra em um loop "for" com contador "i" de 1 até o número maximo de colunas de "sim". { r2 <- round((summary((lm(sim[,i]~obs)))$r.squared),3) #22 Atribui a "r2" o "r²" obtido no summary() da regressao linear. r <- round(cov(obs,sim[,i])/(sd(obs)*sd(sim[,i])),3) #23 Atribui a "r" o resultado do calculo do índice estatístico "r". r.abs <- abs(r) #24 Transforma os valores obtidos do índice estatistico "r" em valores absolutos "r.abs". if(r.abs >= 0.0 && r.abs <= 0.1) {nivelr <- ("Muito baixa");} #25 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Muito baixa". if(r.abs > 0.1 && r.abs <= 0.3) {nivelr <- ("Baixa");} #26 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Baixa". if(r.abs > 0.3 && r.abs <= 0.5) {nivelr <- ("Moderada");} #27 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Moderada". if(r.abs > 0.5 && r.abs <= 0.7) {nivelr <- ("Alta");} #28 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Alta". if(r.abs > 0.7 && r.abs <= 0.9) {nivelr <- ("Muito alta");} #29 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Muito alta". if(r.abs > 0.9 && r.abs <= 1.0) {nivelr <- ("Quase perfeita")} #30 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Quase perfeita". d <- round(1-(sum((sim[,i]-obs)^2)/sum((abs(sim[,i]-mean(obs))+abs(obs-mean(obs)))^2)),3) #31 Atribui a "d" o resultado do calculo do índice estatistico "d". c <- round((1-(sum((sim[,i]-obs)^2)/sum((abs(sim[,i]-mean(obs))+abs(obs-mean(obs)))^2)))* #32 Atribui a "c" o resultado do cálculo índice estatistico "c". sqrt(sum((sim[,i]-mean(obs))^2)/sum((obs-mean(obs))^2)),3) #33 Atribui a "c" o resultado do cálculo índice estatistico "c". if(c <= 0.41) {nivelc <- ("Pessimo");} #34 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Pessimo". if(c > 0.41 && c <= 0.50) {nivelc <- ("Mau");} #35 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Mau". if(c > 0.51 && c <= 0.61) {nivelc <- ("Sofrivel");} #36 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Sofrivel". if(c > 0.61 && c <= 0.66) {nivelc <- ("Mediano");} #37 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Mediano". if(c > 0.66 && c <= 0.76) {nivelc <- ("Bom");} #38 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Bom". if(c > 0.76 && c <= 0.85) {nivelc <- ("Muito bom")}; #39 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Muito bom". if(c > 0.85) {nivelc <- ("Otimo")} #40 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Otimo". EM <- round((sum(sim[,i]-obs))/length(obs),3) #41 Atribui a "EM" o resultado do cálculo do indice estatistico "EM". EAM <- round((sum(abs(sim[,i]-obs)))/length(obs),3) #42 Atribui a "EAM" o resultado do cálculo indice estatistico "EAM". REQM <- round(sqrt(sum((sim[,i]-obs)^2))/length(obs),3) #43 Atribui a "REQM" o resultado do cálculo indice estatistico "REQM". EF <- round(1-((sum((obs-mean(obs))^2)-sum((obs-sim[,i])^2))/sum((obs-mean(obs))^2)),3) #44 Atribui a "EF" o resultado do cálculo indice estatistico "EF". resultado[1,i] <- c(r2) #45 Atribui a linha 1 de "resultado" o(s) valor(es) de "r2". resultado[2,i] <- c(r) #46 Atribui a linha 2 de "resultado" o(s) valor(es) de "r". resultado[3,i] <- c(nivelr) #47 Atribui a linha 3 de "resultado" o(s) valor(es) "nivelr". resultado[4,i] <- c(d) #48 Atribui a linha 4 de "resultado" o(s) valor(es) de "d". resultado[5,i] <- c(c) #49 Atribui a linha 5 de "resultado" o(s) valor(es) de "c". resultado[6,i] <- c(nivelc) #50 Atribui a linha 6 de "resultado" o(s) valor(es) de "nivelc". resultado[7,i] <- c(EM) #51 Atribui a linha 7 de "resultado" o(s) valor(es) de "EM". resultado[8,i] <- c(EAM) #52 Atribui a linha 8 de "resultado" o(s) valor(es) de "EAM". resultado[9,i] <- c(REQM) #53 Atribui a linha 9 de "resultado" o(s) valor(es) de "REQM". resultado[10,i] <- c(EF) #54 Atribui a linha 10 de "resultado" o(s) valor(es) de "EF". } resultado <- as.data.frame(resultado) #55 Transforma "resultado" em um "data.frame" e guarda em "resultado". } if(indice == "r2") #56 Se o usuario escolher somente o indice "r2". { N <- ncol(sim) #57 Atribui a "N" o numero de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=1) #58 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("r2") #59 Atribui o nome do indices "r2" a linha de "resultado". colnames(resultado) = c(colnames(sim)) #60 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #61 Entra em um loop "for" com contador "i" de 1 ate o numero maximo de colunas de "sim". { r2 <- round((summary((lm(sim[,i]~obs)))$r.squared),3) #62 Atribui a "r2" o "r²" obtido no summary() da regressão linear. resultado[1,i] <- (r2) #63 Atribui a linha 1 de "resultado" o(s) valor(es) de "r2". } resultado <- as.data.frame(resultado) #64 Transforma "resultado" em um "data.frame" e guarda em "resultado". } if(indice == "r") #65 Se o usuario escolher somente o indice "r". { N <- ncol(sim) #66 Atribui a "N" o numero de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=2) #67 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("r","Interpretacao r") #68 Atribui o nome do indice "r" e sua interpretacao as linhas de "resultado". colnames(resultado) = c(colnames(sim)) #69 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #70 Entra em um loop "for" com contador "i" de 1 até o numero maximo de colunas de "sim". { r <- round(cov(obs,sim[,i])/(sd(obs)*sd(sim[,i])),3) #71 Atribui a "r" o resultado do cálculo do indice estatistico "r". r.abs <- abs(r) #72 Transforma os valores obtidos do indice estatistico "r" em valores absolutos "r.abs". if(r.abs >= 0.0 && r.abs <= 0.1) {nivelr <- ("Muito baixa");} #73 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Muito baixa". if(r.abs > 0.1 && r.abs <= 0.3) {nivelr <- ("Baixa");} #74 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Baixa". if(r.abs > 0.3 && r.abs <= 0.5) {nivelr <- ("Moderada");} #75 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Moderada". if(r.abs > 0.5 && r.abs <= 0.7) {nivelr <- ("Alta");} #76 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Alta". if(r.abs > 0.7 && r.abs <= 0.9) {nivelr <- ("Muito alta");} #77 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Muito alta". if(r.abs > 0.9 && r.abs <= 1.0) {nivelr <- ("Quase perfeita")} #78 Se o valor de "r.abs" estiver nesse intervalo, atribui a "nivelr" a interpretacao "Quase perfeita". resultado[1,i] <- c(r) #79 Atribui a linha 1 de "resultado" o(s) valor(es) de "r". resultado[2,i] <- c(nivelr) #80 Atribui a linha 2 de "resultado" o(s) valor(es) de "nivelr". } resultado <- as.data.frame(resultado) #81 Transforma "resultado" em um "data.frame" e guarda em "resultado". } if(indice == "d") #82 Se o usuario escolher somente o indice "d". { N <- ncol(sim) #83 Atribui a "N" o numero de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=1) #84 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("d") #85 Atribui o nome do indice "d" a linha de "resultado". colnames(resultado) = c(colnames(sim)) #86 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #87 Entra em um loop "for" com contador "i" de 1 até o numero maximo de colunas de "sim". { d <- round(1-(sum((sim[,i]-obs)^2)/sum((abs(sim[,i]-mean(obs))+abs(obs-mean(obs)))^2)),3) #88 Atribui a "d" o resultado do calculo do indice estatistico "d". resultado[1,i] <- c(d) #89 Atribui a linha 1 de "resultado" o(s) valor(es) de "d". } resultado <- as.data.frame(resultado) #90 Transforma "resultado" em um "data.frame" e guarda em "resultado". } if(indice == "c") #91 Se o usuario escolher somente o índice "c". { N <- ncol(sim) #92 Atribui a "N" o número de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=2) #93 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("c","Desempenho c") #94 Atribui o nome do indice "c" e seu desempenho as linhas de "resultado". colnames(resultado) = c(colnames(sim)) #95 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #96 Entra em um loop "for" com contador "i" de 1 até o numero maximo de colunas de "sim". { c <- round((1-(sum((sim[,i]-obs)^2)/sum((abs(sim[,i]-mean(obs))+abs(obs-mean(obs)))^2)))*sqrt(sum((sim[,i]-mean(obs))^2)/sum((obs-mean(obs))^2)),3) #97 Atribui a "c" o resultado do cálculo do índice estatistico "c". if(c <= 0.41) {nivelc <- ("Pessimo");} #98 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Pessimo". if(c > 0.41 && c <= 0.50) {nivelc <- ("Mau");} #99 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Mau". if(c > 0.51 && c <= 0.61) {nivelc <- ("Sofrivel");} #100 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Sofrivel". if(c > 0.61 && c <= 0.66) {nivelc <- ("Mediano");} #101 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Mediano". if(c > 0.66 && c <= 0.76) {nivelc <- ("Bom");} #102 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Bom". if(c > 0.76 && c <= 0.85) {nivelc <- ("Muito bom")}; #103 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Muito bom". if(c > 0.85) {nivelc <- ("Otimo")} #104 Se o valor de "c" estiver nesse intervalo, atribui a "nivelc" o desempenho "Otimo". resultado[1,i] <- c(c) #105 Atribui a linha 1 de "resultado" o(s) valor(es) de "c". resultado[2,i] <- c(nivelc) #106 Atribui alinha 2 de "resultado" o(s) valor(es) de "nivelc". } resultado <- as.data.frame(resultado) #107 Transforma "resultado" em um "data.frame" e guarda em "resultado". } if(indice == "EM") #108 Se o usuario escolher somente o indice "EM". { N <- ncol(sim) #109 Atribui a "N" o numero de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=1) #110 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("EM") #111 Atribui o nome do indice "EM" a linha de "resultado". colnames(resultado) = c(colnames(sim)) #112 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #113 Entra em um loop "for" com contador "i" de 1 ate o numero maximo de colunas de "sim". { EM <- round((sum(sim[,i]-obs))/length(obs),3) #114 Atribui a "EM" o resultado do calculo do indice estatistico "EM". resultado[1,i] <- c(EM) #115 Atribui a linha 1 de "resultado" o(s) valor(es) de "EM". } resultado <- as.data.frame(resultado) #116 Transforma "resultado" em um "data.frame" e guarda em "resultado". } if(indice == "EAM") #117 Se o usuario escolher somente o indice "EAM". { N <- ncol(sim) #118 Atribui a "N" o numero de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=1) #119 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("EAM") #120 Atribui o nome do indice "EAM" a linha de "resultado". colnames(resultado) = c(colnames(sim)) #121 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #122 Entra em um loop "for" com contador "i" de 1 ate o numero maximo de colunas de "sim". { EAM <- round((sum(abs(sim[,i]-obs)))/length(obs),3) #123 Atribui a "EAM" o resultado do calculo do índice estatistico "EAM". resultado[1,i] <- c(EAM) #124 Atribui a linha 1 de "resultado" o(s) valor(es) de "EAM". } resultado <- as.data.frame(resultado) #125 Transforma "resultado" em um "data.frame" e guarda em "resultado". } if(indice == "REQM") #126 Se o usuario escolher somente o índice "REQM". { N <- ncol(sim) #127 Atribui a "N" o numero de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=1) #128 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("REQM") #129 Atribui o nome do indice 'REQM" a linha de "resultado". colnames(resultado) = c(colnames(sim)) #130 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #131 Entra em um loop "for" com contador "i" de 1 ate o numero maximo de colunas de "sim". { REQM <- round(sqrt(sum((sim[,i]-obs)^2))/length(obs),3) #132 Atribui a "REQM" o resultado do cálculo do índice estatistico "REQM". resultado[1,i] <- c(REQM) #133 Atribui a linha 1 de "resultado" o(s) valor(es) de "REQM". } resultado <- as.data.frame(resultado) #134 Transforma "resultado" em um "data.frame" e guarda em "resultado". } if(indice == "EF") #135 Se o usuario escolher somente o índice "EF". { N <- ncol(sim) #136 Atribui a "N" o numero de colunas de "sim". resultado <- matrix(NA, ncol=N, nrow=1) #137 Cria uma matriz "resultado" para inserir os valores obtidos no fluxo ou loop. rownames(resultado) <- c("EF") #138 Atribui o nome do indice "EF" a linha de "resultado". colnames(resultado) = c(colnames(sim)) #139 Atribui os nomes das colunas de "sim" as colunas de "resultado". for(i in 1:ncol(sim)) #140 Entra em um loop "for" com contador "i" de 1 ate o numero maximo de colunas de "sim". { EF <- round(1-((sum((obs-mean(obs))^2)-sum((obs-sim[,i])^2))/sum((obs-mean(obs))^2)),3) #141 Atribui a "EF" resultado do calculo do índice estatistico "EF". resultado[1,i] <- c(EF) #142 Atribui a linha 1 de "resultado" o(s) valor(es) de "EF". } resultado <- as.data.frame(resultado) #143 Transforma "resultado" em um "data.frame" e guarda em "resultado". } ################################## ### Criando os resultados ### ################################# ### Tabela com os índices: tabela <- resultado #144 Atribui a "tabela" o "data.frame" "resultado. View(tabela) #145 Abre uma nova aba no R com a "tabela" organizada. ### Gráficos de dispersão: for(j in 1:ncol(sim)) #146 Entra em um loop "for" com contador "j" de 1 ate o numero maximo de colunas de "sim". { max.obs <- max(obs, na.rm = TRUE) #147 Atribui a "max.obs" o maior valor dos dados "obs". max.sim <- max(sim[,j], na.rm = TRUE) #148 Atribui a "max.sim" o maior valor dos dados "sim". if (max.obs > max.sim) #149 Se "max.obs" for maior que "max.sim": {xy <- round(coef(lm(sim[,j]~obs)),2) #150 Atribui a "xy" os coeficientes da regressão linear. x11() #151 Abre dispositivo de tela. par (mfrow = c (1, 1)) #152 Dispositivo de tela sera para so uma coluna/um grafico. plot (sim[,j]~obs, #153 Plota area do grafico com os dados observados e simulados. bty = "o", #154 Coloca margens nos lados 1 e 2. pch = 19, #155 Altera formato de pontos para categoria 19. cex = 1.2, #156 Altera o tamanho dos pontos. xlab = "Observados", ylab = "Simulados", #157 Insere os titulos dos eixos x e y. xlim = c(0,max.obs), ylim = c(0,max.obs)) #158 Coloca os titulos dos eixos x e y. abline(xy,lwd=3, col="red") #159 Traca a reta da regressao linear realizada "xy". segments(0,0,x1=max.obs,y1=max.obs, lwd=1.8, col = "black") #160 Traca a reta 1:1 no grafico de dispersao. eq <- paste0("obs = ", xy[1], ifelse(sign(xy[2])==1, " + ", " - "), abs(xy[2]), " * sim") #161 Atribui a "eq" os caracteres concatenados que formam a equacao da regressao linear. mtext(eq, 1, line=-1, padj=0) #162 Insere o "eq" no grafico correspondente. gr.r2 <- paste0("r2 = ", round((summary((lm(sim[,j]~obs)))$r.squared),3)) #163 Atribui a ""gr.r2" os caracteres: "r2" e seu valor correspondente. mtext(gr.r2, 1, line=-2, padj=0)} #164 Insere o "gr.r2" no grafico correspondente. if (max.sim > max.obs) #165 Se "max.sim" for maior que "max.obs": {xy <- round(coef(lm(sim[,j]~obs)),2) #166 Atribui a "xy" os coeficientes da regressao linear. x11() #167 Abre dispositivo de tela. par (mfrow = c (1, 1)) #168 Dispositivo de tela sera para so uma coluna/um grafico. plot (sim[,j]~obs, #169 Plota area do grafico com os dados observados e simulados. bty = "o", #170 Coloca margens nos lados 1 e 2. pch = 19, #171 Altera formato de pontos para categoria 19. cex = 1.2, #172 Altera o tamanho dos pontos. xlab = "Observados", ylab = "Simulados", #173 Insere os titulos dos eixos x e y. xlim = c(0,max.sim), ylim = c(0,max.sim)) #174 Coloca os titulos dos eixos x e y. abline(xy,lwd=3, col="red") #175 Traca a reta da regressao linear realizada "xy". segments(0,0,x1=max.sim,y1=max.sim, lwd=1.8, col = "black") #176 Traca a reta 1:1 no grafico de dispersao. eq <- paste0("obs = ", xy[1], ifelse(sign(xy[2])==1, " + ", " - "), abs(xy[2]), " * sim") #177 Atribui a "eq" os caracteres concatenados que formam a equacao da regressao linear. mtext(eq, 1, line=-1, padj=0) #178 Insere o "eq" no grafico correspondente. gr.r2 <- paste0("r2 = ", round((summary((lm(sim[,j]~obs)))$r.squared),3)) #179 Atribui a ""gr.r2" os caracteres: "r2" e seu valor correspondente. mtext(gr.r2, 1, line=-2, padj=0)} #180 Insere o "gr.r2" no grafico correspondente. } return(tabela) #181 Retorna ao usuário a "tabela" com os resultados dos indices estatisticos para cada coluna de "sim". }