Relatório Agronômico da Safra 2019/2020
Equipe: Debora Lang, Guilherme Oliveira, Mônica Rodrigues, Paulo Dullius, Waldir Shu; autor do documento: Leonardo Reffatti
26/03/2020
1 Introdução
A Cooperativa Agroindustrial Nova Aliança, através do trabalho conjunto das equipes de assessoramento técnico e TI, organiza anualmente o projeto de rastreabilidade da produção agrícola de seus associados produtores de uvas.
Este relatório traz os dados coletados, organizados e interpretados referentes ao inventário de áreas de produção de uvas dos associados da Cooperativa referente ao ciclo produtivo 2019/2020.
1.1 Pacotes R necessários
library(sp)
library(purrr)
library(dplyr)
library(sf)
library(leaflet)
library(leaflet.extras)
library(htmltools)
library(htmlwidgets)
library(knitr)
library(markdown)
library(rmarkdown)
library(carData)
library(car)
library(sciplot)
library(kableExtra)
library(plyr)
library(RColorBrewer)
library(ggplot2)
library(hrbrthemes)
library(ggridges)
library(tableHTML)
library(dygraphs)
library(xts)
library(leaflet.minicharts)
library(permute)
library(lattice)
library(vegan)
library(DT)
library(plotly)
library(tidyr)
library(rlang)
library(broom)1.2 Carregando dados, fonte NAWeb
setwd("C:/Rpubs")
dados<-read.table("cenario_producao_2_safra2020.txt", h=T)
attach(dados)
#Observações:
#- NA para 0s
#- #N/D, ajustar
#- remover outras culturas
#verificação somente da UVA2 Resumo geral de dados
O Resumo geral apresenta uma exploração dos dados gerais da viticultura da Nova Aliança. Neste seção inicial está exposto os dados de área plantada de vinhedos, produção, indicadores de produtividade e qualidade organizados por categorias referente a Safra 2019/2020.
#preparação de dados
df.producao <- dados %>%
na.omit()
df.sem.producao <- setdiff(dados, df.producao)
df.producao = mutate(df.producao, SITUACAO = paste("COM_PRODUCAO"))
df.sem.producao = mutate(df.sem.producao, SITUACAO = paste("SEM_PRODUCAO"))
df.total <- bind_rows(df.producao, df.sem.producao)
df.parcelas <- df.total %>%
group_by(SITUACAO, TIPO) %>%
summarise(PRODUCAO = sum(PRODUCAO),
AREA = sum(AREA),
N_PARCELAS = length(PARCELA),
GRAU_MEDIO = mean(GRAU_MEDIO))
df.parcelas <- df.parcelas %>%
mutate(PRODUTIVIDADE = PRODUCAO/AREA)
is.num <- sapply(df.parcelas, is.numeric)
df.parcelas[is.num] <- lapply(df.parcelas[is.num], round, 1)
df.parcelas[nrow(df.parcelas)+1, ] <- c("TOTAL", "NA", round(sum(df.parcelas$PRODUCAO), digits = 1), round(sum(df.parcelas$AREA), digits = 2), sum(df.parcelas$N_PARCELAS), "NA", "NA")2.1 Quadro 1 - produção (kg), área (hectares), nº parcelas, grau médio (grau Babo), produtividade (kg/ha) em comuns e finas.
datatable(df.parcelas)2.2 Figura 1 - distribuição das áreas em hectares COM/SEM produção.
fig <- df.total %>% plot_ly(labels = ~SITUACAO, values = ~AREA)
fig <- fig %>% add_pie(hole = 0.6)
fig <- fig %>% layout(title = "Mapeamento 2019/20", showlegend = T,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig2.3 Mapa 1 - Localização das parcelas COM/SEM produção.
2.4 Figura 2 - distribuição da área (hectares) e produção (kg) nas categorias comuns e finas.
fig <- plot_ly()
fig <- fig %>% add_pie(hole = 0.5, data = df.total, labels = ~df.total$TIPO, values = ~df.total$AREA,
name = "AREA", domain = list(row = 0, column = 0))
fig <- fig %>% add_pie(hole = 0.5, data = df.total, labels = ~df.total$TIPO, values = ~df.total$PRODUCAO,
name = "PRODUCAO", domain = list(row = 0, column = 1))
fig <- fig %>% layout(title = "Mapeamento 2019/20", showlegend = T,
grid=list(rows=1, columns=2),
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig#Inventário e Identificação de áreas classificadas pelo Sistema de Produção na Safra 2020 (Convencional | Orgânicas | Em Conversão | Bordadura).
df.organicos <- df.total %>%
group_by(SITUACAO, SISTEMA_PRODUCAO) %>%
summarise(PRODUCAO = sum(PRODUCAO),
AREA = sum(AREA),
N_PARCELAS = length(PARCELA),
GRAU_MEDIO = mean(GRAU_MEDIO))
df.organicos <- df.organicos %>%
mutate(PRODUTIVIDADE = PRODUCAO/AREA)
is.num <- sapply(df.organicos, is.numeric)
df.organicos[is.num] <- lapply(df.organicos[is.num], round, 1)
df.organicos[nrow(df.organicos)+1, ] <- c("TOTAL", "NA", round(sum(df.organicos$PRODUCAO), digits = 1), round(sum(df.organicos$AREA), digits = 2), sum(df.organicos$N_PARCELAS), "NA", "NA")2.5 Quadro 2 - dados gerais de produção (kg), área (hectares), nº parcelas, grau médio (grau babo), produtividade (kg/ha) por sistema de produção.
#quadro 1 - variedade, producao, area, parcelas, produtividade e grau medio
datatable(df.organicos)2.6 Figura 3 - distribuição da área (hectares) e produção (kg) por Sistema de produção.
fig <- plot_ly()
fig <- fig %>% add_pie(hole = 0.5, data = dados, labels = ~dados$SISTEMA_PRODUCAO, values = ~dados$AREA,
name = "AREA", domain = list(row = 0, column = 0))
fig <- fig %>% add_pie(hole = 0.5, data = dados, labels = ~dados$SISTEMA_PRODUCAO, values = ~dados$PRODUCAO,
name = "PRODUCAO", domain = list(row = 0, column = 1))
fig <- fig %>% layout(title = "Mapeamento 2019/20", showlegend = T,
grid=list(rows=1, columns=2),
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig2.7 Quadro 3 - produção (kg), área (hectares), nº parcelas, nº grupos familiares, por núcleo.
datatable(df.nucleos.resumo.1)2.8 Figura 4 - distribuição da área (hectares), produção (kg), nº de parcelas e nº de grupos familiares por núcleo.
df.nucleos.plot.1 <- df.nucleos[1:6,]
fig <- plot_ly()
fig <- fig %>% add_pie(hole = 0.5, data = df.nucleos.plot.1, labels = ~df.nucleos.plot.1$NUCLEO, values = ~df.nucleos.plot.1$AREA,
name = "AREA", domain = list(row = 0, column = 0))
fig <- fig %>% add_pie(hole = 0.5, data = df.nucleos.plot.1, labels = ~df.nucleos.plot.1$NUCLEO, values = ~df.nucleos.plot.1$PRODUCAO,
name = "PRODUCAO", domain = list(row = 0, column = 1))
fig <- fig %>% add_pie(hole = 0.5, data = df.nucleos.plot.1, labels = ~df.nucleos.plot.1$NUCLEO, values = ~df.nucleos.plot.1$N_PARCELA,
name = "N_PARCELA", domain = list(row = 1, column = 0))
fig <- fig %>% add_pie(hole = 0.5, data = df.nucleos.plot.1, labels = ~df.nucleos.plot.1$NUCLEO, values = ~df.nucleos.plot.1$N_GRUPO_FAMILIAR,
name = "N_GRUPO_FAMILIAR", domain = list(row = 1, column = 1))
fig <- fig %>% layout(title = "Mapeamento 2019/20", showlegend = T,
grid=list(rows=2, columns=2),
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig2.9 Quadro 4 - indicadores de produtividade (kg/ha), área média por parcela (hectares), produção média por grupo familiar (kg), área média por grupo familiar (hectares), média de nº parcelas por grupo familiar, por núcleo.
datatable(df.nucleos.resumo.2)3 Resumo de dados das variedades
O resumo de dados das variedades apresenta uma exploração dos dados específicos de das principais variedades da Nova Aliança. Nesta seção contém os dados de área plantada, produção, indicadores de produtividade e qualidade organizados por variedades referente a Safra 2019/2020.
df1 <- dados %>%
na.omit() %>%
group_by (VARIEDADE) %>%
summarise(PRODUCAO = sum(PRODUCAO),
AREA = sum(AREA),
N_PARCELAS = length(PARCELA),
GRAU_MEDIO = mean(GRAU_MEDIO))
df2 <- df1 %>%
mutate(PRODUTIVIDADE = PRODUCAO/AREA)
is.num <- sapply(df2, is.numeric)
df2[is.num] <- lapply(df2[is.num], round, 1)
df2[nrow(df2)+1, ] <- c("TOTAL", round(sum(df2$PRODUCAO), digits = 1), round(sum(df2$AREA), digits = 2), sum(df2$N_PARCELAS), round(mean(df2$GRAU_MEDIO), digits = 1), round(sum(df2$PRODUCAO)/sum(df2$AREA), digits = 0))3.1 Figura 5 - distribuição de produção (kg), área (hectares) e nº parcelas por variedade.
fig <- plot_ly()
fig <- fig %>% add_pie(hole = 0.5, data = df1, labels = ~df1$VARIEDADE, values = ~df1$PRODUCAO,
name = "PRODUCAO", domain = list(row = 0, column = 0))
fig <- fig %>% add_pie(hole = 0.5, data = df1, labels = ~df1$VARIEDADE, values = ~df1$AREA,
name = "AREA", domain = list(row = 0, column = 1))
fig <- fig %>% add_pie(hole = 0.5, data = df1, labels = ~df1$VARIEDADE, values = ~df1$N_PARCELAS,
name = "N_PARCELAS", domain = list(row = 0, column = 2))
fig <- fig %>% layout(title = "Mapeamento 2019/20", showlegend = T,
grid=list(rows=1, columns=3),
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
fig3.2 Quadro 5 - produção (kg), área (hectares), nº parcelas, nº grupos familiares por núcleo.
#quadro 1 - variedade, producao, area, parcelas, produtividade e grau medio
datatable(df2)3.3 Figura 6 - dispersão produtividade (kg/ha) e grau babo das Variedades agrupadas por comuns e finas.
#dispersao Produtividade e Grau Babo
df3 <- dados %>%
na.omit() %>%
group_by (VARIEDADE, TIPO) %>%
summarise(PRODUCAO = sum(PRODUCAO),
AREA = sum(AREA),
N_PARCELAS = length(PARCELA),
GRAU_MEDIO = mean(GRAU_MEDIO),
PRODUTIVIDADE = mean(PRODUTIVIDADE))
is.num <- sapply(df3, is.numeric)
df3[is.num] <- lapply(df3[is.num], round, 1)
cor <- c("purple", "green")
fig <- plot_ly(data = df3, x = ~PRODUTIVIDADE, y = ~GRAU_MEDIO, color = ~TIPO, colors = cor, text = ~paste0(VARIEDADE, "-",PRODUTIVIDADE, "-", GRAU_MEDIO))
fig3.4 Figura 7 - boxplot produtividade (kg/ha) em comuns e finas.
#dispersao Produtividade e Grau Babo
df.comum <- dados %>%
na.omit() %>%
filter(TIPO== "COMUM")
is.num <- sapply(df.comum, is.numeric)
df.comum[is.num] <- lapply(df.comum[is.num], round, 1)
df.fina <- dados %>%
na.omit() %>%
filter(TIPO== "FINA")
is.num <- sapply(df.fina, is.numeric)
df.fina[is.num] <- lapply(df.fina[is.num], round, 1)
fig <- plot_ly(type = 'box')
fig <- fig %>% add_boxplot(y = df.comum$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "COMUM")
fig <- fig %>% add_boxplot(y = df.fina$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "FINA")
fig <- fig %>% layout(yaxis = list(range = c(0, 70000), title = "PRODUTIVIDADE"))
fig3.5 Figura 8 - boxplot produtividade (kg/ha) nos sistemas de produção.
#dispersao Produtividade e Grau Babo
df.convencional <- dados %>%
na.omit() %>%
filter(SISTEMA_PRODUCAO== "CONVENCIONAL")
is.num <- sapply(df.convencional, is.numeric)
df.convencional[is.num] <- lapply(df.convencional[is.num], round, 1)
df.organico <- dados %>%
na.omit() %>%
filter(SISTEMA_PRODUCAO== "ORGANICO")
is.num <- sapply(df.organico, is.numeric)
df.organico[is.num] <- lapply(df.organico[is.num], round, 1)
fig <- plot_ly(type = 'box')
fig <- fig %>% add_boxplot(y = df.convencional$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "CONVENCIONAL")
fig <- fig %>% add_boxplot(y = df.organico$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "ORGANICO")
fig <- fig %>% layout(yaxis = list(range = c(0, 70000), title = "PRODUTIVIDADE"))
fig3.6 Figura 9 - boxplot produtividade (kg/ha) nas principais variedades.
#dispersao Produtividade e Grau Babo
df.isabel <- dados %>%
na.omit() %>%
filter(VARIEDADE== "ISABEL")
df.bordo <- dados %>%
na.omit() %>%
filter(VARIEDADE== "BORDO_(IVES)")
df.niagara.branca <- dados %>%
na.omit() %>%
filter(VARIEDADE== "NIAGARA_BRANCA")
df.cora <- dados %>%
na.omit() %>%
filter(VARIEDADE== "BRS_CORA")
df.carmem <- dados %>%
na.omit() %>%
filter(VARIEDADE== "BRS_CARMEN")
df.moscato.embrapa <- dados %>%
na.omit() %>%
filter(VARIEDADE== "MOSCATO_EMBRAPA")
fig <- plot_ly(type = 'box')
fig <- fig %>% add_boxplot(y = df.isabel$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "ISABEL")
fig <- fig %>% add_boxplot(y = df.bordo$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "BORDO")
fig <- fig %>% add_boxplot(y = df.niagara.branca$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "NIAGARA_BRANCA")
fig <- fig %>% add_boxplot(y = df.cora$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "BRS_CORA")
fig <- fig %>% add_boxplot(y = df.moscato.embrapa$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "MOSCATO_EMBRAPA")
fig <- fig %>% add_boxplot(y = df.carmem$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "BRS_CARMEM")
fig <- fig %>% layout(yaxis = list(range = c(0, 70000), title = "PRODUTIVIDADE"))
fig3.7 Figura 10 - médias de produtividade (kg/ha) e grau babo nas parcelas das 7 principais variedades.
df.6.variedades.comuns <- bind_rows(df.isabel, df.bordo, df.niagara.branca, df.cora, df.carmem, df.moscato.embrapa)
df.6.variedades.comuns <- df.6.variedades.comuns %>%
droplevels()
#transformando colunas em fatores da variável
df5 <- df.6.variedades.comuns %>% gather(key = "INDICADOR", value = "resultado", PRODUTIVIDADE, GRAU_MEDIO, na.rm = FALSE, convert = FALSE)
media_indicador <- ddply(df5, c("VARIEDADE", "INDICADOR"), summarise, length = mean(resultado))
sd_indicador <- ddply(df5, c("VARIEDADE", "INDICADOR"), summarise, length = sd(resultado))
indicador <- data.frame(media_indicador, sd_indicador$length)
names(indicador)[names(indicador) == 'sd_indicador.length'] <- 'devio_padrao'
names(indicador)[names(indicador) == 'length'] <- 'resultado'
fig <- plot_ly(data = indicador[which(indicador$INDICADOR == 'PRODUTIVIDADE'),], x = ~VARIEDADE, y = ~resultado, type = 'scatter', mode = 'markers',
name = 'PRODUTIVIDADE',
error_y = ~list(array = devio_padrao,
color = '#000000'))
fig <- fig %>% add_trace(data = indicador[which(indicador$INDICADOR == 'GRAU_MEDIO'),], name = 'GRAU_MEDIO')
fig4 Resumo específico de dados: variedade ISABEL
df.isabel <- dados %>%
na.omit() %>%
filter(VARIEDADE== "ISABEL") %>%
group_by(NUCLEO) %>%
summarise(PRODUCAO = sum(PRODUCAO),
AREA = sum(AREA),
N_PARCELA = length(PARCELA),
PRODUTIVIDADE = mean(PRODUTIVIDADE),
GRAU_MEDIO = mean(GRAU_MEDIO),
ALTITUDE = mean(ALTITUDE))
is.num <- sapply(df.isabel, is.numeric)
df.isabel[is.num] <- lapply(df.isabel[is.num], round, 1)
df.isabel[nrow(df.isabel)+1, ] <- c("TOTAL", round(sum(df.isabel$PRODUCAO), digits = 1), round(sum(df.isabel$AREA), digits = 2), sum(df.isabel$N_PARCELA), round(mean(df.isabel$PRODUTIVIDADE), digits = 0), round(mean(df.isabel$GRAU_MEDIO), digits = 1), round(mean(df.isabel$ALTITUDE), digits = 0))4.1 Quadro 6 - dados isabel por núcleo.
datatable(df.isabel)4.2 Figura 10 - boxplot produtividade de isabel por núcleo.
df.isabel.nucleos <- dados %>%
na.omit() %>%
filter(VARIEDADE== "ISABEL")
df.isabe.pb <- df.isabel.nucleos %>%
na.omit() %>%
filter(NUCLEO== "PB")
df.isabe.jc <- df.isabel.nucleos %>%
na.omit() %>%
filter(NUCLEO== "JC")
df.isabe.np <- df.isabel.nucleos %>%
na.omit() %>%
filter(NUCLEO== "NP")
df.isabe.fc <- df.isabel.nucleos %>%
na.omit() %>%
filter(NUCLEO== "FC")
df.isabe.sg <- df.isabel.nucleos %>%
na.omit() %>%
filter(NUCLEO== "SG")
df.isabe.sv <- df.isabel.nucleos %>%
na.omit() %>%
filter(NUCLEO== "SV")
fig <- plot_ly(type = 'box')
fig <- fig %>% add_boxplot(y = df.isabe.fc$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "FC")
fig <- fig %>% add_boxplot(y = df.isabe.jc$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "JC")
fig <- fig %>% add_boxplot(y = df.isabe.np$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "NP")
fig <- fig %>% add_boxplot(y = df.isabe.pb$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "PB")
fig <- fig %>% add_boxplot(y = df.isabe.sg$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "SG")
fig <- fig %>% add_boxplot(y = df.isabe.sv$PRODUTIVIDADE, jitter = 0.3, pointpos = -1.8, boxpoints = 'all',
marker = list(color = 'rgb(7,40,89)'),
line = list(color = 'rgb(7,40,89)'),
name = "SV")
fig <- fig %>% layout(yaxis = list(range = c(0, 70000), title = "PRODUTIVIDADE"))
fig4.3 Figura 11 - dispersão produtividade e grau babo de isabel por núcleo.
fig <- plot_ly(data = df.isabel.nucleos, x = ~PRODUTIVIDADE, y = ~GRAU_MEDIO, color = ~NUCLEO, text = ~paste0(ASSOCIADO, "-",PRODUTIVIDADE, "-", GRAU_MEDIO, "-", PARCELA, "-", AREA, "ha"))
fig4.4 Figura 12 - histograma 2D produtividade e grau babo por parcelas de isabel.
s <- subplot(
plot_ly(x = df.isabel.nucleos$PRODUTIVIDADE, color = I("black"), type = 'histogram'),
plotly_empty(),
plot_ly(x = df.isabel.nucleos$PRODUTIVIDADE, y = df.isabel.nucleos$GRAU_MEDIO, type = 'histogram2dcontour', showscale = T),
plot_ly(y = df.isabel.nucleos$GRAU_MEDIO, color = I("black"), type = 'histogram'),
nrows = 2, heights = c(0.2, 0.8), widths = c(0.8, 0.2),
shareX = TRUE, shareY = TRUE, titleX = F, titleY = F
)
x <- list(
range = c(0, 50000),
title = "PRODUTIVIDADE")
y <- list(title = "GRAU BABO")
fig <- layout(s, showlegend = F, xaxis = x, yaxis = y)
fig4.5 Figura 13 - médias de produtividade e grau babo por núcleo na isabel.
df5 <- df.isabel.nucleos %>% gather(key = "INDICADOR", value = "resultado", PRODUTIVIDADE, GRAU_MEDIO, na.rm = FALSE, convert = FALSE)
media_indicador <- ddply(df5, c("NUCLEO", "INDICADOR"), summarise, length = mean(resultado))
sd_indicador <- ddply(df5, c("NUCLEO", "INDICADOR"), summarise, length = sd(resultado))
indicador <- data.frame(media_indicador, sd_indicador$length)
names(indicador)[names(indicador) == 'sd_indicador.length'] <- 'devio_padrao'
names(indicador)[names(indicador) == 'length'] <- 'resultado'
fig <- plot_ly(data = indicador[which(indicador$INDICADOR == 'PRODUTIVIDADE'),], x = ~NUCLEO, y = ~resultado, type = 'scatter', mode = 'markers',
name = 'PRODUTIVIDADE',
error_y = ~list(array = devio_padrao,
color = '#000000'))
fig <- fig %>% add_trace(data = indicador[which(indicador$INDICADOR == 'GRAU_MEDIO'),], name = 'GRAU_MEDIO')
fig4.6 Teste 1 - anova, produtividade para isabel por núcleo.
resultado.aov.isabel.nucleo.produtividade<-aov(df.isabel.nucleos$PRODUTIVIDADE~df.isabel.nucleos$NUCLEO)
summary(resultado.aov.isabel.nucleo.produtividade)## Df Sum Sq Mean Sq F value Pr(>F)
## df.isabel.nucleos$NUCLEO 5 6.206e+09 1.241e+09 13.47 1.23e-12 ***
## Residuals 809 7.455e+10 9.215e+07
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1tidy(resultado.aov.isabel.nucleo.produtividade)## # A tibble: 2 x 6
## term df sumsq meansq statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 df.isabel.nucleos$NUCL~ 5 6205792953. 1.24e9 13.5 1.23e-12
## 2 Residuals 809 74548364205. 9.21e7 NA NAO resultado do teste estatístico anova foi significativo, com um valor de p igual à 1.228492510^{-12}, NA.Ou seja, existe diferença significativa entre a produtividade média para os núcleos.
Na sequencia, com o teste de Tuckey é possível verificar os valores de p eum uma comparação de pares, os quais nos indicam se as diferenças de grau babo médio entre cada um dos núcleos foi significativa ou não.
4.7 Teste 2 - tuckey, produtividade para isabel por núcleo.
Executando o teste de Tuckey é possível verificarmos em uma comparação de pares os valores de p os quais nos indicam se as diferenças de produtividade entre cada um dos núcleos foi significativa ou não.
TukeyHSD(resultado.aov.isabel.nucleo.produtividade, ordered = TRUE)## Tukey multiple comparisons of means
## 95% family-wise confidence level
## factor levels have been ordered
##
## Fit: aov(formula = df.isabel.nucleos$PRODUTIVIDADE ~ df.isabel.nucleos$NUCLEO)
##
## $`df.isabel.nucleos$NUCLEO`
## diff lwr upr p adj
## NP-SV 6679.8753 2485.8658 10873.885 0.0000904
## SG-SV 7074.1880 2475.3160 11673.060 0.0001826
## FC-SV 8038.3395 3417.8907 12658.788 0.0000121
## JC-SV 10556.8740 5978.5060 15135.242 0.0000000
## PB-SV 10728.3298 6526.8500 14929.810 0.0000000
## SG-NP 394.3127 -2825.1109 3613.736 0.9993111
## FC-NP 1358.4642 -1891.7068 4608.635 0.8398325
## JC-NP 3876.9987 686.9332 7067.064 0.0071808
## PB-NP 4048.4545 1427.8635 6669.046 0.0001678
## FC-SG 964.1515 -2793.9757 4722.279 0.9778482
## JC-SG 3482.6860 -223.5826 7188.955 0.0794903
## PB-SG 3654.1418 424.9925 6883.291 0.0160746
## JC-FC 2518.5345 -1214.4736 6251.543 0.3861493
## PB-FC 2689.9903 -569.8146 5949.795 0.1728168
## PB-JC 171.4558 -3028.4247 3371.336 0.99998834.8 Figura 14 - médias de produtividade e IC por núcleo na isabel.
fun = function(x) mean(x, na.rm=TRUE)
lineplot.CI(df.isabel.nucleos$NUCLEO, df.isabel.nucleos$PRODUTIVIDADE, type="p", xlab="NUCLEO",
ylab="PRODUTIVIDADE",
main="Medias e IC de PRODUTIVIDADE por nucleo",
ci.fun= function(x) c(mean(x)-qt(0.975, 48)*se(x),
mean(x)+qt(0.975, 48)*se(x)))
4.9 Figura 15 - médias de grau medio e IC por núcleo na isabel.
fun = function(x) mean(x, na.rm=TRUE)
lineplot.CI(df.isabel.nucleos$NUCLEO, df.isabel.nucleos$GRAU_MEDIO, type="p", xlab="NUCLEO",
ylab="GRAU_MEDIO",
main="Medias e IC de GRAU_MEDIO por nucleo",
ci.fun= function(x) c(mean(x)-qt(0.975, 48)*se(x),
mean(x)+qt(0.975, 48)*se(x)))
4.10 Teste 3 - anova, grau babo para isabel por núcleo.
resultado.aov.isabel.nucleo.graubabo<-aov(df.isabel.nucleos$GRAU_MEDIO~df.isabel.nucleos$NUCLEO)
summary(resultado.aov.isabel.nucleo.graubabo)## Df Sum Sq Mean Sq F value Pr(>F)
## df.isabel.nucleos$NUCLEO 5 108.8 21.755 41.36 <2e-16 ***
## Residuals 809 425.5 0.526
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1tidy(resultado.aov.isabel.nucleo.graubabo)## # A tibble: 2 x 6
## term df sumsq meansq statistic p.value
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 df.isabel.nucleos$NUCLEO 5 109. 21.8 41.4 5.88e-38
## 2 Residuals 809 426. 0.526 NA NAO resultado do teste estatístico anova foi significativo, com um valor de p igual à 5.881178610^{-38}, NA.Ou seja, existe diferença significativa entre o grau babo médio da isabel para os núcleos.
Na sequencia, com o teste de Tuckey é possível verificar os valores de p eum uma comparação de pares, os quais nos indicam se as diferenças de grau babo médio entre cada um dos núcleos foi significativa ou não.
4.11 Teste 4 - tuckey, grau babo para isabel por núcleo.
TukeyHSD(resultado.aov.isabel.nucleo.graubabo, ordered = TRUE)## Tukey multiple comparisons of means
## 95% family-wise confidence level
## factor levels have been ordered
##
## Fit: aov(formula = df.isabel.nucleos$GRAU_MEDIO ~ df.isabel.nucleos$NUCLEO)
##
## $`df.isabel.nucleos$NUCLEO`
## diff lwr upr p adj
## SV-FC 0.17785265 -0.17123179 0.5269371 0.6928452
## NP-FC 0.20007326 -0.04548387 0.4456304 0.1842021
## JC-FC 0.42202059 0.13998412 0.7040571 0.0003086
## SG-FC 0.64293651 0.35900224 0.9268708 0.0000000
## PB-FC 1.00233487 0.75604988 1.2486199 0.0000000
## NP-SV 0.02222061 -0.29464546 0.3390867 0.9999556
## JC-SV 0.24416794 -0.10173721 0.5900731 0.3337819
## SG-SV 0.46508386 0.11762959 0.8125381 0.0019601
## PB-SV 0.82448222 0.50705175 1.1419127 0.0000000
## JC-NP 0.22194733 -0.01906871 0.4629634 0.0911516
## SG-NP 0.44286325 0.19962915 0.6860973 0.0000037
## PB-NP 0.80226161 0.60427055 1.0002527 0.0000000
## SG-JC 0.22091592 -0.05910032 0.5009322 0.2146453
## PB-JC 0.58031428 0.33855670 0.8220719 0.0000000
## PB-SG 0.35939836 0.11542946 0.6033673 0.00041024.12 Figura 16 - dispersão de produtividade e grau babo para isabel por núcleo, formando agrupamentos conforme parâmetros de produtividade e grau babo.
4.12.1 A = Produtividade > média e Grau medio > média (parcelas)
4.12.2 B = Produtividade < média e Grau medio > média (parcelas)
4.12.3 C = Produtividade > média e Grau medio < média (parcelas)
4.12.4 D = Produtividade < média e Grau medio < média (parcelas)
fig <- plot_ly(data = df.isabel.nucleos, x = ~PRODUTIVIDADE, y = ~GRAU_MEDIO, color = ~AGRUPAMENTOS, text = ~paste0(ASSOCIADO, "-",PRODUTIVIDADE, "-", GRAU_MEDIO, "-", PARCELA, "-", AREA, "ha"))
fig4.13 Figura 17 - produção das categorias formadas nos núcleos, conforme parâmetros de produtividade e grau babo.
4.14 Figura 18 - percentual da produção das categorias formadas nos núcleos, conforme parâmetros de produtividade e grau babo.
df.isabel.agrupamentos.nucleo.2 = mutate(df.isabel.agrupamentos.nucleo.2, TOTAL = A+B+C+D)
df.isabel.agrupamentos.nucleo.2 = mutate(df.isabel.agrupamentos.nucleo.2, A.perc = round((A/TOTAL)*100, digits = 2))
df.isabel.agrupamentos.nucleo.2 = mutate(df.isabel.agrupamentos.nucleo.2, B.perc = round((B/TOTAL)*100, digits = 2))
df.isabel.agrupamentos.nucleo.2 = mutate(df.isabel.agrupamentos.nucleo.2, C.perc = round((C/TOTAL)*100, digits = 2))
df.isabel.agrupamentos.nucleo.2 = mutate(df.isabel.agrupamentos.nucleo.2, D.perc = round((D/TOTAL)*100, digits = 2))
fig <- plot_ly(df.isabel.agrupamentos.nucleo.2, x = ~NUCLEO, y = ~A.perc, type = 'bar', name = 'A')
fig <- fig %>% add_trace(y = ~B.perc, name = 'B')
fig <- fig %>% add_trace(y = ~C.perc, name = 'C')
fig <- fig %>% add_trace(y = ~D.perc, name = 'D')
fig <- fig %>% layout(title = 'Produção nos Agrupramentos') %>% layout(yaxis = list(title = '%'), barmode = 'stack')
fig