Assistente para ajuste de modelos de degradação in situ e produção de gases

blog13

           As técnicas de digestibilidade in situ e produção de gases, são bastante utilizadas na nutrição de ruminantes para se avaliar o valor dos alimentos. Estas técnicas permitem estimar a taxa de degradação dos alimentos no ambiente ruminal e quando associado a um marcador, que nos forneça informações sobre a taxa de passagem, podemos estimar a degradabilidade ruminal do alimento.

             Os principais modelos utilizados para ajustar o desaparecimento ruminal do alimento ao longo do tempo ou a produção cumulativa de gases ao longo do tempo são funções não lineares. A solução para estimativa dos parâmetros nesta funções somente pode ser obtido por métodos numéricos , seguindo procedimentos te otimização interativas. Procedimentos de otimização interativas exigem que o analista forneça os valores iniciais dos parâmetros e após sucessivas interações os parâmetros vão sendo ajustados de tal forma que a soma de quadrados dos resíduos (SQR) é reduzida em cada passo. O critério de convergência será atendido quando a SQR atingir valor mínimo ( ou máxima probabilidade da variável resposta for obtida), a partir deste ponto nenhuma melhora no ajuste do modelo é possível através dos parâmetros.

            Os valores iniciais devem ser próximos aos valores desconhecidos dos parâmetros que serão estimados ou o procedimento de otimização pode não convergir. Além disso valores iniciais inadequados podem levar o algoritmo a convergir para um minimo local ao invés do minimo global, esperado na estimativa dos quadrados mínimos.

            No post de hoje apresento um assistente útil no processo de ajuste de modelos não lineares, para análise de experimentos de digestibilidade in situ e produção de gasses. Este assistente é uma extensão do script fornecido pelo Prof. Walmes em seu blog Ridículas que modifiquei para trabalhar com vários modelos. O código depende dos pacotes Rpanel e nlme estarem instalados em seu sistema. Os modelos utilizados foram descritos nos trabalhos de López et al (1999) e France et al (2000) para modelos de digestibilidade in situ e produção de gases respectivamente. Segue algumas observações para seu uso: (veja vídeo)

a) Para utilizar este assistente os dados devem estar no formato CSV (separado por vírgula);
b) Pare selecionar subgrupos de dados escreva uma expressão logical indicando qual subgrupo de dados selecionar (não usar aspas)
p.ex: dieta==1 & concentracao==10 para selecionar os dados identificados por dieta==1 e concentração igual a 10 ; dieta==2 | dieta ==4 & concentracao==40 para selecionar dietas identificados por 2 ou 4 e concentração igual a 40, veja manual da função gnls {nlme} para mais informações.

c) Nas caixas “nome da variável dependente (y)” e ” nome da variável independente (x)” insira o nome das variáveis dependente e independente conforme encontra-se em seu banco de dados importado.

d) Ao clicar em ajustar uma curva de cor azul será sobreposta ao gráfico, para indicar convergência. Quando não houver convergência uma mensagem será apresentada sobre o gráfico. Quando outro motivo, além do limite para critério de convergência, gerar erro nenhuma mensagem ou curva na cor azul será mostrada e a mensagem de erro/warnings pode ser vista no console;

e) Clique em ajustar para ver o modelo ajustado sobre o R console (equivalente a digitar “summary(modelo))

f) O modelo Gompertz para produção de gases onde são fornecidos dois modelos Gompertz I e Gompertz II esses modelos diferem quanto ao ponto de inflexão da curva: Ambos os modelos não são simétricos sobre o ponto de inflexão M. Para o modelo Gompertz I M é obtido da fórmula K = exp [–exp (cM)] e para Gompertz II M=(1/c)*ln(c/b). Veja France et al 2000 e López (2008) (cap 3 , pag. 55) para mais detalhes

até a proxima dica!


#Baixe o arquivo em algum diretório em seu computador
# Em "destfile=" coloque o endereço do diretório onde deseja salvar o arquivo

Windows
download.file("https://www.dropbox.com/s/el82xcu4fft3tpg/gases.csv?raw=1",destfile="c:\Users\(username)\Desktop\gases.csv")

Linux 
download.file("https://www.dropbox.com/s/el82xcu4fft3tpg/gases.csv?raw=1",destfile="~/Área de trabalho/gases.csv")

#================================================
# Interface gráfica para ajuste de modelos de digestibilidade in situ e produção de gases
# Autor: Fernando Souza
# Data: 22/04/2016
#================================================
#--------Verifica se os pacotes necessários estão instalados e instala-os em caso negativo--------

packages <- c("rpanel","nlme") # Verifica se os pacotes necessários estão instalados, em caso negativo faz a instalação if (length(setdiff(packages, rownames(installed.packages()))) > 0) {
install.packages(setdiff(packages, rownames(installed.packages())))
}

# ativa os pacotes necessários
for (i in 1:length(packages)){
library(packages[i],character.only = TRUE)
print(paste("O seguinte pacote foi carregado:",packages[i],sep=""))
}

#-------------------------Seleciona o banco de dados---------------------
#------------banco dados deve ser salvo como csv-------------------------
database<-function(panel){
dados<<-read.csv(file.choose(), header=TRUE)
print(head(dados));
return(panel)
}
#Altera o nome da variável dependente e independente definida pelo usuário para y e x
ren_y<-function(panel){
var_dep<<-panel$var_y
colnames(dados)[grep(var_dep,colnames(dados))]<<-"y"
print(colnames(dados)); return(panel)}

ren_x <- function(panel){
var_indep<<-panel$var_x
colnames(dados)[grep(var_indep,colnames(dados))]<<-"x"
print(colnames(dados)); return(panel)}

#================================================#-----------------Ajusta os modelos de degradabilidade in situ e produção de gases------------------
#---Referencias in situ: Lopez et al,(1999); produção gases : France et al  (2000)----------------
#================================================
#nlsajust é excutada quando clicar no botão "Ajustar"

nlsajust <- function(panel){
## ajuste do modelo não linear
controle<<-nlmeControl(nlmStepMax=1000,nlsTol=0.01,maxIter=100)
if(panel$modelo == "Orskov & McDonald"){
n0 <<- try(gnls(y~a+b*(1-exp(-c*(x-d))), # modelo de Orskov & McDonanld (1979)
data=da,control=controle,na.action=na.omit,
start=start),)
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a+b*(1-exp(-c*(x-d))),
add=TRUE, col="blue"))
aju <<- n0
}

}
if(panel$modelo=="Michaelis-Menten"){
n0 <<- try(gnls(y~a+b*((x-d)/(x-d+c)), # modelo Michaelis-Menten (ou Inversa Polinomial)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a+b*((x-d)/(x-d+c)),
add=TRUE, col="blue"))
aju <<- n0
}

}
if(panel$modelo=="Van Milgen"){
n0 <<- try(gnls(y~a+b*(1-((c*exp(-d*x)-d*exp(-c*x))/(c-d))), # modelo lag compartimental (Van Milgen et al (1991)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a+b*(1-((c*exp(-d*x)-d*exp(-c*x))/(c-d))),
add=TRUE, col="blue"))
aju <<- n0
}
}
if(panel$modelo=="France"){
n0 <<- try(gnls(y~a+b*(1-exp(-c*(x-e)-d*(sqrt(x)-sqrt(e)))), # Modelo Generalized Mitscherlich Dhanoa et al (1995)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a+b*(1-exp(-c*(x-e)-d*(sqrt(x)-sqrt(e)))),
add=TRUE, col="blue"))
aju <<- n0
}
}
if(panel$modelo=="Michaelis-Menten Generalizado"){
n0 <<- try(gnls(y~a+b*((x^c)/((x^c)+(d^c))), # modelo Michaelis-Menten Generalizado (France et al,1998)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a+b*((x^c)/((x^c)+(d^c))),
add=TRUE, col="blue"))
aju <<- n0
}
}
if (panel$modelo=="Inversa Exponencial"){
n0 <<- try(gnls(y~a+b*((1-exp(-c*x))/(1+d*exp(-c*x))), # modelo inversa exponencial (France et al,1990)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a+b*((1-exp(-c*x))/(1+d*exp(-c*x))),
add=TRUE, col="blue"))
aju <<- n0
}
}
if(panel$modelo=="Gompertz I"){
n0 <<- try(gnls(y~a+b*((d-d^exp(-c*x))/(d-1)),
# Gompertz curve, asymmetrical about an inflection point M, # which can be calculated from K = exp[−exp (cM)] (France et al., 1990)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a+b*((d-d^exp(-c*x))/(d-1)),
add=TRUE, col="blue"))
aju <<- n0
}
}

if(panel$modelo=="Von Bertallanffy"){
n0 <<- try(gnls(y~a+b*((1-exp(-c*x))^1/d), # modelo Von Bertallanfy (Ricker,1979)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a+b*((1-exp(-c*x))^1/d),
add=TRUE, col="blue"))
aju <<- n0
}

}
if(panel$modelo == "PG-Oskov & McDonald"){
n0 <<- try(gnls(y~a*(1-exp(-c*(x-b))), # modelo Oskov & McDonald (1979)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*(1-exp(-c*(x-b))),
add=TRUE, col="blue"))
aju <<- n0
}

}
if(panel$modelo=="PG-Michaelis-Menten"){
n0 <<- try(gnls(y~a*((x-b)/(x-b+c)), # modelo Michaelis-Menten
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*((x-b)/(x-b+c)),
add=TRUE, col="blue"))
aju <<- n0
}

}
if(panel$modelo=="PG-Van Milgen"){
n0 <<- try(gnls(y~a*(1-((c*exp(-b*x)-b*exp(-c*x))/(c-b))), # modelo Van Mingen et al (1991)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*(1-((c*exp(-b*x)-b*exp(-c*x))/(c-b))),
add=TRUE, col="blue"))
aju <<- n0
}
}
if(panel$modelo=="PG-France"){
n0 <<- try(gnls(y~a*(1-exp(-c*(x-d)-b*(sqrt(x)-sqrt(d)))), # modelo Mitscherlich (France 2000)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*(1-exp(-c*(x-d)-b*(sqrt(x)-sqrt(d)))),
add=TRUE, col="blue"))
aju <<- n0
}
}
if(panel$modelo=="PG-Michaelis-Menten Generalizado"){
n0 <<- try(gnls(y~a*((x^c)/((x^c)+(b^c))), # modelo Michaelis-Menten Generalizado (France,2000)
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*((x^c)/((x^c)+(b^c))),
add=TRUE, col="blue"))
aju <<- n0
}
}
if (panel$modelo=="PG-Inversa Exponencial"){
n0 <<- try(gnls(y~a*((1-exp(-c*x))/(1+b*exp(-c*x))), # modelo inversa exponencial
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*((1-exp(-c*x))/(1+b*exp(-c*x))),
add=TRUE, col="blue"))
aju <<- n0
}
}
if(panel$modelo=="PG-Gompertz I"){
#Modelo Gompertz, non-symmetrical about an inflection point M, which can be calculated from
#K = exp [–exp (cM)]
n0 <<- try(gnls(y~a*((b-b^exp(-c*x))/(b-1)),
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*((b-b^exp(-c*x))/(b-1)),
add=TRUE, col="blue"))
aju <<- n0
}
}

if(panel$modelo=="PG-Gompertz II"){
#Modelo Gompertz, non-symmetrical about an inflection point M=(1/c)*ln(c/b)
n0 <<- try(gnls(y~a*((1-exp((-b/c)*(exp(c*x)-1)))), # modelo Gompertz II
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*((1-exp((-b/c)*(exp(c*x)-1)))),
add=TRUE, col="blue"))
aju <<- n0
}

}

if(panel$modelo=="Von Bertalanffy"){
n0 <<- try(gnls(y~a*((1-exp(-c*x))^1/b), # modelo Von Bertalanffy modificado
data=da,control=controle,na.action=na.omit,
start=start))
if(class(n0)=="try-error"){
par(usr=c(0, 1, 0, 1))
text(0.5, 0.5, "Não convergiu!\nAproxime mais.", col="red", cex=2)
}else{

with(as.list(coef(n0)), curve(a*((1-exp(-c*x))^1/b),
add=TRUE, col="blue"))
aju <<- n0
}

}
panel
}

#================================================#--------------------------Seleciona subgrupo dos dados--------------------------------------------------------
#================================================
subgrupo <- function(panel){


if(panel$grupo ==""){
da<<-dados
} else{

da <<- subset(dados,subset=eval(parse(text=panel$grupo)))

}
return(panel)
}

#================================================
#--Função que cria o gráfico,e sobrepoe a curva sobre os pontos quando os sliders são #deslizados.
#================================================
vg <- function(panel){

if (panel$modelo == "Orskov & McDonald"|panel$modelo=="Michaelis-Menten"|panel$modelo=="Van Milgen"|panel$modelo=="Michaelis-Menten Generalizado"|panel$modelo=="Inversa Exponencial"|panel$modelo=="Gompertz I"|panel$modelo=="Von Bertalanffy"){

start <<-panel[c("a","b","c","d")]
}
if (panel$modelo =="France"){
## lista com valores iniciais vindos dos deslizadores
start <<- panel[c("a","b","c","d","e")]
}
if (panel$modelo == "PG-Orskov & McDonald"|panel$modelo=="PG-Michaelis-Menten"|panel$modelo=="PG-Van Milgen"|panel$modelo=="PG-Michaelis-Menten Generalizado"|panel$modelo=="PG-Inversa Exponencial"|panel$modelo=="PG-Gompertz I"|panel$modelo=="PG-Gompertz II"|panel$modelo=="PG-Von Bertalanffy"){

start<<-panel[c("a","b","c")]
}
if(panel$modelo=="PG-France"){

start<<-panel[c("a","b","c","d")]

}

par(mar=c(4.1,4.2,3.1,1))
with(da,plot(x,y,ylab= var_dep,xlab=var_indep))

if(panel$modelo =="Orskov & McDonald"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a+b(1-exp(-c*(x-d)))')))
with(start, curve(a+b*(1-exp(-c*(x-d))),
add=TRUE, col=2, lty=2))}

if(panel$modelo=="Michaelis-Menten"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a+b((x-d)/(x-d+c))')))
with(start, curve(a+b*((x-d)/(x-d+c)),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="Van Milgen"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a+b(1-((c*exp(-c*x))/(c-d)))')))
with(start, curve(a+b*(1-((c*exp(-d*x)-d*exp(-c*x))/(c-d))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="France"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a+b(1-exp(-c*(x-e)-d*(sqrt(x)-sqrt(e))))')))
with(start, curve(a+b*(1-exp(-c*(x-e)-d*(sqrt(x)-sqrt(e)))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="Michaelis-Menten Generalizado"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a+b((x^c)/((x^c)+(d^c)))')))
with(start, curve(a+b*((x^c)/((x^c)+(d^c))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="Inversa Exponencial"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a+b((1-exp(-c*x))/(1+d*exp(-c*x)))')))
with(start, curve(a+b*((1-exp(-c*x))/(1+d*exp(-c*x))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="Gompertz I"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a+b((d-d^exp(-c*x))/(d-1))')))
with(start, curve(a+b*((d-d^exp(-c*x))/(d-1)),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="Von Bertalanffy"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a+b((1-exp(-c*x))^1/d)')))
with(start, curve(a+b*((1-exp(-c*x))^1/d),
add=TRUE, col=2, lty=2))}
if(panel$modelo =="PG-Orskov & McDonald"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a(1-exp(-c*(x-b)))')))
with(start, curve(a*(1-exp(-c*(x-b))),
add=TRUE, col=2, lty=2))}

if(panel$modelo=="PG-Michaelis-Menten"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a((x-b)/(x-b+c))')))
with(start, curve(a*((x-b)/(x-b+c)),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="PG-Van Milgen"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a(1-((c*exp(-b*x)-b*exp(-c*x)/(c-b)))')))
with(start, curve( a*(1-((c*exp(-b*x)-b*exp(-c*x))/(c-b))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="PG-France"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a(1-exp(-c*(x-d)-b*(sqrt(x)-sqrt(d))))')))
with(start, curve(a*(1-exp(-c*(x-d)-b*(sqrt(x)-sqrt(d)))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="PG-Michaelis-Menten Generalizado"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a*((x^c)/((x^c)+(b^c)))')))
with(start, curve(a*((x^c)/((x^c)+(b^c))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="PG-Inversa Exponencial"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a*((1-exp(-c*x))/(1+b*exp(-c*x)))')))
with(start, curve(a*((1-exp(-c*x))/(1+b*exp(-c*x))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="PG-Gompertz I"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a*((b-b^exp(-c*x))/(b-1))')))
with(start, curve(a*((b-b^exp(-c*x))/(b-1)),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="PG-Gompertz II"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a*((1-exp((-b/c)*(exp(c*x)-1))))')))
with(start, curve(a*((1-exp((-b/c)*(exp(c*x)-1)))),
add=TRUE, col=2, lty=2))}
if(panel$modelo=="PG-Von Bertalanffy"){
## sobrepõe a curva controlada pelos deslizadores
title(main= expression(paste(Y,'=','a*((1-exp(-c*x))^1/b)')))
with(start, curve(a*((1-exp(-c*x))^1/b),
add=TRUE, col=2, lty=2))}

return(panel)
}

#================================================
#----------------mostra o resultado quando o botão ver ajuste é acionado----------------------
#================================================
verajust <- function(panel){
a<-summary(aju)
print(a)
panel
}

# cria objetos vazios que serão preenchidos durante processo
da <- c(); start <- list();
#================================================
# Gera a interface gráfica para trabalho
#================================================
panel <- rp.control()
#botão para importar banco de dados
rp.button(panel, action=database,foreground="black",background = "orange",title="IMPORTAR DADOS")
# Obtem os
#nomes das variáveis dependentes
rp.textentry(panel=panel, variable=var_y,width = 10,foreground = "black", background = "gray87",
labels="NOME DA VARIÁVEL DEPENDENTE (y):",
initval="",
action=ren_y)

rp.textentry(panel=panel, variable=var_x,width=10,foreground = "black", background = "gray87",
labels="NOME DA VARIÁVEL INDEPENDENTE(x):",
initval="",
action=ren_x)
rp.textentry(panel,variable=grupo,initval="",labels="SUBGRUPO DE DADOS", ,
foreground = "black",background="gray87",action=subgrupo)

models_name<<- c("--Modelos Dig. in Situ--","Orskov & McDonald","Inversa Polinomial","Van Milgen","France","Michaelis-Menten Generalizado","Inversa Exponencial","Gompertz I","Von Bertalanffy","--Modelos Prod. Gases--","PG-Orskov & McDonald","PG-Michaelis-Menten","PG-Van Milgen","PG-France","PG-Michaelis-Menten Generalizado","PG-Inversa Exponencial","PG-Gompertz I","PG-Gompertz II","PG-Von Bertalanffy")

mod_id<<- c("--Modelos Dig. in situ--","MOD1","MOD2","MOD3","MOD4","MOD5","MOD6","MOD7","MOD8","---Modelos Prod. Gases---","PG1","PG2","PG3","PG4","PG5","PG6","PG7","PG8","PG9")

rp.listbox(panel,modelo, vals=models_name,rows=5,title="Modelos",foreground = "black",background="gray87",action=vg)

rp.text(panel,"Parâmetros do modelo")

# controla parâmetros do modelo

rp.slider(panel, a,0.001,100.001, initval=50.001,foreground="black",background="gray87", title="a", showvalue=TRUE,showvaluewidth=4, action=vg)
rp.slider(panel, b,-5.001,5.001, initval=0.001,foreground="black",background="gray87",title="b", showvalue=TRUE,showvaluewidth=4, action=vg)
rp.slider(panel, c, -1.001,1.001, initval=0.001,foreground="black",background="gray87",title="c", showvalue=TRUE,showvaluewidth=4, action=vg)
rp.slider(panel, d, -2.001,2.001, initval=0.001,foreground="black",background="gray87", title="d", showvalue=TRUE,showvaluewidth=4, action=vg)
rp.slider(panel, e, 0.001,5.001, initval=2.5,foreground="black",background="gray87",title="e", showvalue=TRUE,showvaluewidth=4, action=vg)

# cria botão "Ajustar"
rp.button(panel, action=nlsajust,foreground="black",background = "orange", title="AJUSTAR")
rp.button(panel, action=verajust,foreground="black",background="springgreen",title="VER AJUSTE")


#================================================
Anúncios
Esse post foi publicado em Experimentos, Regressões e marcado , , , , , , . Guardar link permanente.

2 respostas para Assistente para ajuste de modelos de degradação in situ e produção de gases

  1. Luigi Cavalcanti disse:

    Belo trabalho Fernando. tem algum banco de exemplo? um dput? ou pelo menos um cabeçalho padrao para o arquivo csv?

    • nandodesouza disse:

      Olá Francis, tudo bem? Que bom que gostou. Qualquer sugestão de melhoria será bem vindo.

      Então, segue o endereço para baixar um arquivo para exemplo (já está atualizado no blog)
      Substitua em ‘destfile” o endereço para o diretório onde deseja salvar o arquivo.

      download.file(“https://www.dropbox.com/s/el82xcu4fft3tpg/gases.csv?raw=1″,destfile=”c:\Users\(username)\Desktop\gases.csv”)

      Um grande abraço

Deixe um comentário

Preencha os seus dados abaixo ou clique em um ícone para log in:

Logotipo do WordPress.com

Você está comentando utilizando sua conta WordPress.com. Sair / Alterar )

Imagem do Twitter

Você está comentando utilizando sua conta Twitter. Sair / Alterar )

Foto do Facebook

Você está comentando utilizando sua conta Facebook. Sair / Alterar )

Foto do Google+

Você está comentando utilizando sua conta Google+. Sair / Alterar )

Conectando a %s