SEMANA 09 - Estruturas de dados. Indexação. Loop em data.frame (tibble) - P2 - Atividade B09

library(readxl)
library(tibble)
library(minpack.lm)
# 1. Importar a base de dados
# 2. Atribuir classe para cada material genético
#--------- Estrutura padrão -----------------------#
# 3. Identificar e quantificar as classes de interesse
# 4. Como executar o procedimento e como acessar os resultados
# 5. Criar uma data.frame (ou tibble) para receber os resultados
# 6. Executar o processo de repetição (loop)
#     6.1. Filtrar a classe de interesse
#     6.2. Executar os procedimentos necessários (muda bastante)
#     6.3. Acesso os resultados
#     6.4. Modificar a data.frame, gerada em (5), para receber os resultados


# 1. Importar a base de dados
##-------- Ler arquivo hospedado na internet --------------##
library(httr)
url <- "https://gmarcatti.github.io/dados/dados.xlsx"
GET(url, write_disk(arq <- tempfile(fileext = ".xlsx")))
dados <- read_excel(arq)
# dados <- read_excel("C:/dados/dados.xlsx") # se o arquivo estiver no pc
dados

# 2. Atribuir classe para cada material genético
prod <- c("G20", "G22", "G4", "G3", "G2", "G24", "G7", "G18")
inter <- c("G5", "G12", "G9", "G21", "G14", "G11", "G8", "G6")
resis <- c("G1", "G16", "G23", "G15", "G13", "G10", "G19", "G17")

dados$classe_gen <- ""
dados[dados$genotipo %in% prod, "classe_gen"] # filtrar
dados[dados$genotipo %in% prod, "classe_gen"] <- "Produtivo" # filtrar e modificar
dados[dados$genotipo %in% inter, "classe_gen"] <- "Intermediario" # filtrar e modificar
dados[dados$genotipo %in% resis, "classe_gen"] <- "Resistente" # filtrar e modificar
dados
#--------- Estrutura padrão -----------------------#
# 3. Identificar e quantificar as classes de interesse
uni_classe <- unique(dados$classe_gen)
N <- length(uni_classe)
# 4. Como executar o procedimento e como acessar os resultados
nls_geral <- nlsLM(volume ~ exp(b0 - b1 / idade), dados,
                   start = list(b0 = 1, b1 = 1))
summary(nls_geral)
plot(dados$idade, dados$volume, xlab = "Idade (anos)", ylab = "Volume (m³/ha)")
str(summary(nls_geral))
summary(nls_geral)$coefficients[, 1]
coef_geral <- coef(nls_geral)
coef_geral[["b0"]]
coef_geral[["b1"]]
curve(exp(coef_geral[["b0"]] - coef_geral[["b1"]] / x),
      from = 1, to = 8, add = TRUE, col = "blue")
idade_vetor <- seq(1, 8, 0.1)
volume_vetor <- predict(nls_geral, tibble(idade = idade_vetor))
ima_vetor <- volume_vetor / idade_vetor
max(ima_vetor)
ind_max <- which.max(ima_vetor)
ima_vetor[28]
ima_vetor[ind_max]
id_tecnica <- idade_vetor[28]
idade_vetor[61]
ima_vetor[61]
ima_vetor[idade_vetor == 7.0]
volume_vetor[61]
volume_vetor[idade_vetor == 7.0]
# 5. Criar uma data.frame (ou tibble) para receber os resultados
gen_dados <- tibble(classe_gen = character(N),
                    id_tec = numeric(N),
                    ima_max = numeric(N),
                    ima7 = numeric(N),
                    prod7 = numeric(N))
# 6. Executar o processo de repetição (loop)
cores <- c("orange", "green", "red")
idade_est <- seq(1, 8, 0.1)
for (i in 1:N) {
   #     6.1. Filtrar a classe de interesse
   dados_i <- subset(dados, dados$classe_gen == uni_classe[i])
   #     6.2. Executar os procedimentos necessários (muda bastante)
   nls_i <- nlsLM(volume ~ exp(b0 - b1 / idade), dados_i,
                  start = list(b0 = 1, b1 = 1))
   coef_i <- coef(nls_i)
   curve(exp(coef_i[["b0"]] - coef_i[["b1"]] / x),
         from = 1, to = 8, add = TRUE, col = cores[i])
   volume_est <- predict(nls_i, tibble(idade = idade_est))
   ima_est <- volume_est / idade_est
   ind_max_est <- which.max(ima_est)
   #     6.3. Acesso os resultados
   id_tec <- idade_est[ind_max_est]
   ima_max <- ima_est[ind_max_est]
   ima7 <- ima_est[idade_est == 7.0]
   prod7 <- volume_est[idade_est == 7.0]
   #     6.4. Modificar a data.frame, gerada em (5), para receber os resultados
   gen_dados[i, "classe_gen"] <- uni_classe[i]
   gen_dados[i, "id_tec"] <- id_tec
   gen_dados[i, "ima_max"] <- ima_max
   gen_dados[i, "ima7"] <- ima7
   gen_dados[i, "prod7"] <- prod7
}