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

Gustavo Eduardo Marcatti

Ajuste de modelos não-lineares para diferentes estratos (ou grupos)

Subdividir materiais genéticos em grupos previamente definidos
##-------- Ler arquivo hospedado na internet --------------##
library(httr)
url <- "https://gmarcatti.github.io/dados/dados.xlsx"
GET(url, write_disk(arq <- tempfile(fileext = ".xlsx")))
#install.packages("readxl")
library(readxl)
dados <- read_excel(arq)
# dados <- read_excel("C:/dados/dados.xlsx") # se o arquivo estiver no pc
dados
# produtivos
# resistentes
# intermediários
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$info_gen <- ""
# dados[1:5, ]
# dados[1:5, c("volume", "info_gen")]
# dados[dados$volume >= 300, c("volume", "info_gen")]
# dados[dados$genotipo == "G20", "info_gen"]
# dados[dados$genotipo == "G20", "info_gen"] <- "produtivos"
# dados[dados$genotipo == "G22", "info_gen"] <- "produtivos"
dados[dados$genotipo %in% prod, "info_gen"] <- "produtivos"
dados[dados$genotipo %in% inter, "info_gen"] <- "intermediários"
dados[dados$genotipo %in% resis, "info_gen"] <- "resistentes"
table(dados$info_gen)
Estrutura padrão (carcaça) para executar um loop em Data Frame
  1. Identificar e quantificar as classes de interesse
  2. Como executar o procedimento e como acessar os resultados
  3. Criar uma data.frame (ou tibble) para receber os resultados
  4. Executar o processo de repetição (loop)
    4.1. Filtrar a classe de interesse
    4.2. Executar os comandos necessários
    4.3. Acessar os resultados
    4.4. Modificar a data.frame criada em (3) para receber os resultados
# install.packages("minpack.lm")
require(minpack.lm)
# install.packages("tibble")
require(tibble)

# 1. Identificar e quantificar as classes de interesse
uni_gen <- unique(dados$info_gen)
N <- length(uni_gen)
# 2. Como executar o procedimento e como acessar os resultados
# volume = exp(b0 - b1/idade)
# volume ~ idade -> volume = b0 + b1*idade
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)")
points(dados$idade, fitted(nls_geral), col = "blue")
str(summary(nls_geral))
resumo <- summary(nls_geral)
resumo$coefficients
resumo$coefficients[, "Estimate"][[1]]
resumo$coefficients[, "Estimate"][[2]]
# 3. Criar uma data.frame (ou tibble) para receber os resultados
coefs <- tibble(info_gen = character(N),
                b0 = numeric(N),
                b1 = numeric(N))
cores <- c("orange", "green", "red")
# 4. Executar o processo de repetição (loop)
for (i in 1:N) {
   #     4.1. Filtrar a classe de interesse
   d_i <- subset(dados, info_gen == uni_gen[i])
   #     4.2. Executar os comandos necessários
   nls_i <- nlsLM(volume ~ exp(b0 - b1/idade), d_i,
                  start = list(b0 = 1, b1 = 1))
   points(d_i$idade, fitted(nls_i), col = cores[i])
   #     4.3. Acessar os resultados
   resumo_i <- summary(nls_i)
   b0coef = resumo_i$coefficients[, "Estimate"][[1]]
   b1coef = resumo_i$coefficients[, "Estimate"][[2]]
   #     4.4. Modificar a data.frame criada em (3) para receber os resultados
   coefs[i, "info_gen"] <- uni_gen[i]
   coefs[i, "b0"] <- b0coef
   coefs[i, "b1"] <- b1coef
}
coefs
legend("topleft", legend = uni_gen, col = cores, pch = 1)
legend("topleft", legend = c(uni_gen, "geral"), col = c(cores, "blue"), pch = 1)