Análise Exploratória
#-----------------------------------------------------------------------
# Carrega os pacotes necessários.
library(lattice)
library(latticeExtra)
library(nlme)
# library(doBy)
# library(multcomp)
library(plyr)
library(wzRfun)
library(EACS)
#-----------------------------------------------------------------------
# Análise exploratório dos dados.
# Pra facilitar o manuseio, vamos usar um nome curto.
cra <- teca_cra
str(cra)
cra$tens[cra$tens == 0] <- 0.1
xyplot(umid ~ tens | factor(loc), data = cra,
groups = cam, type = c("o"), as.table = TRUE,
strip = TRUE, layout = c(NA, 5),
scales = list(x = list(log = 10)),
xscale.components = xscale.components.log10ticks,
auto.key = list(title = "Camada (cm)", cex.title = 1.1),
ylab = expression("Umidade do solo" ~ (m^{3}~m^{-3})),
xlab = expression(log[10] ~ "Tensão" ~ (kPa)))
#-----------------------------------------------------------------------
# Remove observações atípicas.
del <- with(cra, {
(loc == 4 & cam == levels(cam)[3]) |
(loc == 27 & cam == levels(cam)[1]) |
(loc == 37 & cam == levels(cam)[2]) |
(loc == 47 & cam == levels(cam)[2]) |
(loc == 47 & cam == levels(cam)[3])
})
cra <- droplevels(cra[!del, ])
Ajuste da Curva de Retenção de Água do Solo
#-----------------------------------------------------------------------
# Ajuste da CRA.
xyplot(umid ~ tens,
# data = subset(cra, loc == 40 & cam == "[40, 80)"),
data = cra,
scales = list(x = list(log = 10)),
xscale.components = xscale.components.log10ticks,
ylab = expression("Umidade do solo" ~ (m^{3} ~ m^{-3})),
xlab = expression(log[10] ~ "Tensão" ~ (kPa)))
# Logaritmo na base 10 da tensão matricial.
cra$ltens <- log10(cra$tens)
# Expressão do modelo van Genuchten.
model <- umid ~ Ur + (Us - Ur)/(1 + exp(n * (alp + ltens)))^(1 - 1/n)
# Valores iniciais para os parâmetros da curva.
start <- list(Ur = 0.3, Us = 0.6, alp = -0.5, n = 4)
n00 <- nls(model, data = cra, start = start)
coef(n00)
## Ur Us alp n
## 0.2390291 0.6519457 -0.4708593 2.4380958
#-----------------------------------------------------------------------
# Ajustar para cada unidade experimental, 50 loc x 3 cam = 150 ue, se
# não tivesse sido removido algumas curvas.
cra$ue <- with(cra, interaction(loc, cam, drop = TRUE))
nlevels(cra$ue)
## [1] 145
db <- groupedData(umid ~ ltens | ue,
data = cra, order.groups = FALSE)
n0 <- nlsList(model = model, data = db,
start = as.list(coef(n00)))
c0 <- coef(n0)
pairs(c0)
# Alguma curva sem ajustar?
sum(!complete.cases(c0))
## [1] 1
plot(augPred(n0),
strip = FALSE,
as.table = TRUE,
ylab = expression("Umidade do solo" ~ (m^{3} ~ m^{-3})),
xlab = expression(log[10] ~ "Tensão" ~ (kPa)))
#-----------------------------------------------------------------------
# Determinar os demais parâmetros da curva de água do solo.
params <- as.data.frame(
do.call(rbind, strsplit(rownames(c0),
split = "\\.")))
names(params) <- c("loc", "cam")
params <- transform(params,
loc = as.integer(loc),
cam = factor(cam, levels = levels(cra$cam)))
params <- na.omit(cbind(params, c0))
params <- within(params, {
m <- 1 - 1/n
d <- Us - Ur
S <- -d * n * (1 + 1/m)^(-m - 1)
I <- -alp - log(m)/n
Ui <- Ur + (Us - Ur)/(1 + exp(n * (alp + I)))^(1 - 1/n)
cad <- Ui - Ur
rm(d, m)
})
str(params)
## 'data.frame': 144 obs. of 10 variables:
## $ loc: int 1 12 23 34 45 47 48 49 50 2 ...
## $ cam: Factor w/ 3 levels "[0, 5)","[5, 40)",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Ur : num 0.223 0.169 0.214 0.184 0.251 ...
## $ Us : num 0.648 0.622 0.667 0.66 0.576 ...
## $ alp: num -0.724 -0.578 -0.608 -0.72 -0.809 ...
## $ n : num 3.59 4.24 3.09 4.87 2.38 ...
## $ cad: num 0.227 0.239 0.245 0.249 0.182 ...
## $ Ui : num 0.45 0.408 0.459 0.433 0.433 ...
## $ I : num 0.815 0.642 0.734 0.767 1.037 ...
## $ S : num -0.341 -0.439 -0.306 -0.537 -0.159 ...
## - attr(*, "na.action")=Class 'omit' Named int 88
## .. ..- attr(*, "names")= chr "40.[5, 40)"
# addmargins(xtabs(~loc + cam, data = params))
params <- arrange(params, loc, cam)
splom(params[, -(1:2)], type = c("p", "r"))
Pareando Dados de Produção e da CRA
# Valores das variáveis de produção (se repetem nas tensões e camadas).
plan <- unique(subset(cra, cam == levels(cam)[1] & tens == max(tens),
select = c(loc, alt, dap, vol, prod)))
str(plan)
## 'data.frame': 49 obs. of 5 variables:
## $ loc : int 1 2 3 4 5 6 7 8 9 10 ...
## $ alt : num 12.9 11.9 22.5 20.4 15.6 ...
## $ dap : num 0.194 0.182 0.348 0.304 0.227 ...
## $ vol : num 0.2707 0.0963 0.4974 0.4074 0.2165 ...
## $ prod: num 68.2 24.3 125.3 102.7 54.6 ...
#-----------------------------------------------------------------------
# Junta os valores de produção com parâmetros da CRA. Valores de
# produção vão se repetir para as camadas.
crap <- merge(plan, params)
str(crap)
## 'data.frame': 141 obs. of 14 variables:
## $ loc : int 1 1 1 2 2 2 3 3 3 4 ...
## $ alt : num 12.9 12.9 12.9 11.9 11.9 ...
## $ dap : num 0.194 0.194 0.194 0.182 0.182 ...
## $ vol : num 0.2707 0.2707 0.2707 0.0963 0.0963 ...
## $ prod: num 68.2 68.2 68.2 24.3 24.3 ...
## $ cam : Factor w/ 3 levels "[0, 5)","[5, 40)",..: 2 3 1 1 2 3 1 2 3 2 ...
## $ Ur : num 0.178 0.188 0.223 0.131 0.165 ...
## $ Us : num 0.58 0.647 0.648 0.697 0.573 ...
## $ alp : num -0.833 -0.722 -0.724 -0.548 -0.547 ...
## $ n : num 3.11 3.25 3.59 4.01 2.92 ...
## $ cad : num 0.217 0.247 0.227 0.3 0.222 ...
## $ Ui : num 0.396 0.435 0.45 0.431 0.387 ...
## $ I : num 0.957 0.835 0.815 0.62 0.691 ...
## $ S : num -0.273 -0.329 -0.341 -0.515 -0.257 ...
