transferir modelo da função nls para a função curve() automaticamente
Olá a todos. Estou criando uma função para trabalhar com o pacote Rpanel no qual pretendo criar uma lista de seleção com opção para escolher vários modelos. Como vou trabalhar com vários modelos quero criar funções que automatizem todo o processo. Minha questão é a seguinte: Eu ajusto um modelo não-linear, produzo um gráfico e adiciono a curva do modelo aos gráfico, utilizando a função curve(). Gostaria de passar o modelo para a função curve() de forma que dependendo do modelo selecionado a expressão incluída na função curve() se altere. Tentei a opção modelo$call conforme código abaixo o qual me retorna o lado esquerdo da fórmula. Entretanto não funciona. A função curve retorna a seguinte mensagem de erro; "Error in curve(fm1$call[[2]][[3]], add = TRUE, col = 2) : 'expr' must be a function, or a call or an expression containing 'x' Isto se deve ao fato de a formula retornada pelo comando fm1$call[[2]][[3]] ser do typo "language" typeof(fm1$call[[2]][[3]]) [1] "language" ja tentei utilizar o comando as.expression e não obtive sucesso. Procurei na internet e nada! Como eu posso substituir o comando "fm1$call[[2]][[3]]" na função curve de forma que ela funcione? fm1 <- nls(circumference ~ A/(1+exp((B-age)/C)), Orange,start = list(A = 160, B = 700, C = 350)) plot (circumference~ age, Orange) with(as.list(coef(fm1)), curve("fm1$call[[2]][[3]]",add=TRUE, col=2)) -- ======================================================================= Fernando Souza Zootecnista, DSc. Produção Animal e-mail:nandodesouza@gmail.com https://producaoanimalcomr.wordpress.com/ ========================================================================
Você pode considerar esse painel (interface com rpanel) que fiz durante a minha tese de Doutorado. É uma GUI para ajuste de modelos não lineares. A partir da fórmula a curva ajustada é exibida. Pela descrição do que você pretende fazer, acredito que você não vai precisar mudar muita coisa do que eu já fiz. À disposição. Walmes.
Desculpe, Acesse: https://github.com/walmes/wzRfun/blob/master/R/rp.nls.R À disposição. Walmes.
Pessoal, boa tarde! Tenho interesse no tópico e fiz uns testes. Não sei se ajuda em algo, mas deixo o script pra consulta. ### <code r> head(Orange, 3) mForm <- as.formula("circumference ~ A/(1+exp((B-age)/C))"); mForm; class(mForm) mExpr <- mForm[[3]]; mExpr; class(mExpr) # A/(1 + exp((B - age)/C)) fm1 <- nls(mForm, Orange, start=list(A=160, B=700, C=350)) mPar <- summary(fm1)$parameters[,1] xLim <- with(Orange, range(pretty(age))) varx <- all.vars(mExpr)[!all.vars(mExpr) %in% names(mPar)] sapply(1:length(mPar), function(i) {assign(names(mPar)[i], mPar[i], envir=.GlobalEnv)}) eval(call("curve", mExpr, xLim[1], xLim[2], xname=varx)) # curve(A/(1 + exp((B - age)/C)), xLim[1], xLim[2], xname=varx) plot(circumference~age, Orange) eval(call("curve", mExpr, xLim[1], xLim[2], xname=varx, add=T, col=2)) ### </code> ================================================ Éder Comunello Agronomist (UEM), MSc in Environ. Sciences (UEM) DSc in Agricultural Systems Engineering (USP/Esalq) Brazilian Agricultural Research Corporation (Embrapa) Dourados, MS, Brazil |<O>| ================================================ GEO, -22.2752, -54.8182, 408m UTC-04:00 / DST: UTC-03:00
Senhores, bom dia! Realmente o script disponibilizado pelo Walmes é muito bom. É pra aprender o caminho das pedras! Mas me surgiu uma ideia... Supondo que se queira apenas visualizar o ajuste do modelo, talvez bastasse utilizar predict() e depois adicionar os resultados ao gráfico. ### <code r> head(Orange, 3) mForm <- as.formula("circumference ~ A/(1+exp((B-age)/C))"); mForm; class(mForm) mExpr <- mForm[[3]]; mExpr; class(mExpr) # A/(1 + exp((B - age)/C)) fm1 <- nls(mForm, Orange, start=list(A=160, B=700, C=350)) new <- seq(xLim[1], xLim[2], len=101) pre1 <- predict(fm1, newdata=list(age=new)) plot(circumference~age, Orange) lines(new, pre1, col=2) # title(mForm) title(mExpr) ### </code> ================================================ Éder Comunello Agronomist (UEM), MSc in Environ. Sciences (UEM) DSc in Agricultural Systems Engineering (USP/Esalq) Brazilian Agricultural Research Corporation (Embrapa) Dourados, MS, Brazil |<O>| ================================================ GEO, -22.2752, -54.8182, 408m UTC-04:00 / DST: UTC-03:00
Uma dúvida Eu estou escrevendo um código utilizando o R panel. Ele é uma extensão do código escrito pelo Walmes (no blog ridículas), no qual pretendo adaptá-lo para trabalhar com mais modelos. No código abaixo pretendo fornecer interfaces para a importação dos dados pelo usuário. O nome das variáveis dependente e independente utilizada no banco de dados importado deve ser fornecida pelo usuário e o código substitui o nome destas variáveis por y e x para processamento. Acontece que a função "var_nome" ela captura os nomes fornecidos pelo usuário, no entanto não estou conseguindo realizar a mudança dos respectivos nomes na base de dados. O comando colnames(da)[grep( var_dep,colnames(da))]<-"y" funciona fora da função, mas não parece funcionar dentro da função, uma vez que após rodar os comando abaixo e digitar head(da), os nomes das colunas não são alterados. No exemplo abaixo as colunas PG e Tempo, devem ser substituídas por Y e X respectivamente Como posso resolver isso? require(rpanel) database<-function(panel){ da<-read.csv(file.choose(), header=TRUE) return(panel) } #----------------------------------------------------------------------------- var_nome<-function(panel){ var_dep<<-panel$var_y var_indep<<-panel$var_x colnames(da)[grep(var_dep,colnames(da))]<-"y" colnames(da)[grep(var_indep,colnames(da))]<-"x" return(panel) } panel <- rp.control() #botão para importar banco de dados rp.button(panel, action=database, title="importar dados") # Obtem os nomes das variáveis dependentes rp.textentry(panel=panel, variable=var_y, labels="nome da variável dependente(y):", initval="", action=var_nome) rp.textentry(panel=panel, variable=var_x, labels="nome da variável independente(x):", initval="", action=var_nome) dput(da[1:134,]) da<-structure(list(Tubo = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 8L), Amostra = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L), dieta = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L), concentracao = c(20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 40L), Tempo = c(1L, 2L, 3L, 4L, 5L, 6L, 9L, 12L, 18L, 24L, 30L, 36L, 48L, 60L, 72L, 84L, 96L, 120L, 144L, 1L, 2L, 3L, 4L, 5L, 6L, 9L, 12L, 18L, 24L, 30L, 36L, 48L, 60L, 72L, 84L, 96L, 120L, 144L, 1L, 2L, 3L, 4L, 5L, 6L, 9L, 12L, 18L, 24L, 30L, 36L, 48L, 60L, 72L, 84L, 96L, 120L, 144L, 1L, 2L, 3L, 4L, 5L, 6L, 9L, 12L, 18L, 24L, 30L, 36L, 48L, 60L, 72L, 84L, 96L, 120L, 144L, 1L, 2L, 3L, 4L, 5L, 6L, 9L, 12L, 18L, 24L, 30L, 36L, 48L, 60L, 72L, 84L, 96L, 120L, 144L, 1L, 2L, 3L, 4L, 5L, 6L, 9L, 12L, 18L, 24L, 30L, 36L, 48L, 60L, 72L, 84L, 96L, 120L, 144L, 1L, 2L, 3L, 4L, 5L, 6L, 9L, 12L, 18L, 24L, 30L, 36L, 48L, 60L, 72L, 84L, 96L, 120L, 144L, 1L), PG = c(4.18, 6.16, 8.13, 9.94, 11.74, 13.72, 17.95, 20.77, 21.16, 21.16, 21.16, 21.16, 21.16, 21.16, 21.16, 21.16, 21.16, 21.16, 21.16, 3.56, 6.16, 9.77, 12.98, 15.35, 16.76, 20.15, 21.72, 22.51, 22.51, 22.51, 22.51, 22.51, 22.51, 22.51, 22.51, 22.51, 22.51, 22.51, 4.8, 8.81, 12.42, 14.62, 16.82, 18, 20.37, 21.78, 22.18, 22.18, 22.18, 22.18, 22.18, 22.18, 22.18, 22.18, 22.18, 22.18, 22.18, 3.96, 7.96, 12.19, 14.17, 15.97, 17.38, 19.58, 20.99, 21.95, 21.95, 21.95, 21.95, 21.95, 21.95, 21.95, 21.95, 21.95, 21.95, 21.95, 4.41, 8.02, 11.23, 13.43, 15.41, 16.82, 19.02, 20.6, 20.99, 20.99, 20.99, 20.99, 20.99, 20.99, 20.99, 20.99, 20.99, 20.99, 20.99, 4.58, 8.19, 11.01, 12.59, 14.39, 15.58, 17.55, 19.13, 20.09, 20.09, 20.09, 20.09, 20.09, 20.09, 20.09, 20.09, 20.09, 20.09, 20.09, 4.8, 8.19, 10.95, 12.93, 14.73, 16.31, 18.51, 20.09, 20.88, 20.88, 20.88, 20.88, 20.88, 20.88, 20.88, 20.88, 20.88, 20.88, 20.88, 4.58)), .Names = c("Tubo", "Amostra", "dieta", "concentracao", "Tempo", "PG"), row.names = c(NA, 134L), class = "data.frame") Em 27 de fevereiro de 2016 09:16, Éder Comunello <comunello.eder@gmail.com> escreveu:
Senhores, bom dia!
Realmente o script disponibilizado pelo Walmes é muito bom. É pra aprender o caminho das pedras!
Mas me surgiu uma ideia... Supondo que se queira apenas visualizar o ajuste do modelo, talvez bastasse utilizar predict() e depois adicionar os resultados ao gráfico.
### <code r> head(Orange, 3) mForm <- as.formula("circumference ~ A/(1+exp((B-age)/C))"); mForm; class(mForm) mExpr <- mForm[[3]]; mExpr; class(mExpr) # A/(1 + exp((B - age)/C))
fm1 <- nls(mForm, Orange, start=list(A=160, B=700, C=350))
new <- seq(xLim[1], xLim[2], len=101) pre1 <- predict(fm1, newdata=list(age=new))
plot(circumference~age, Orange) lines(new, pre1, col=2) # title(mForm) title(mExpr) ### </code>
================================================ Éder Comunello Agronomist (UEM), MSc in Environ. Sciences (UEM) DSc in Agricultural Systems Engineering (USP/Esalq) Brazilian Agricultural Research Corporation (Embrapa) Dourados, MS, Brazil |<O>| ================================================ GEO, -22.2752, -54.8182, 408m UTC-04:00 / DST: UTC-03:00
_______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br Leia o guia de postagem (http://www.leg.ufpr.br/r-br-guia) e forneça código mínimo reproduzível.
-- ======================================================================= Fernando Souza Zootecnista, DSc. Produção Animal e-mail:nandodesouza@gmail.com https://producaoanimalcomr.wordpress.com/ ========================================================================
Fernando, Não estou familiarizado com {rpanel}, mas sugiro testar alterando o sinal de atribuição de "<-" para "<<-" help("<<-") ... colnames(da)[grep(var_dep,colnames(da))] <<- "y" colnames(da)[grep(var_indep,colnames(da))] <<- "x" ================================================ Éder Comunello Agronomist (UEM), MSc in Environ. Sciences (UEM) DSc in Agricultural Systems Engineering (USP/Esalq) Brazilian Agricultural Research Corporation (Embrapa) Dourados, MS, Brazil |<O>| ================================================ GEO, -22.2752, -54.8182, 408m UTC-04:00 / DST: UTC-03:00
Fernando, boa tarde! Não sei se você já resolveu, mas consegui renomear as variáveis no exemplo que você tinha proposto... ### <code r> ### dados pra testar da.ori <- structure(list(Tubo = c(1L, 1L, 1L, 1L, 1L, 1L), Amostra = c(1L, 1L, 1L, 1L, 1L, 1L), dieta = c(1L, 1L, 1L, 1L, 1L, 1L), concentracao = c(20L, 20L, 20L, 20L, 20L, 20L), Tempo = 1:6, PG = c(4.18, 6.16, 8.13, 9.94, 11.74, 13.72)), .Names = c("Tubo", "Amostra", "dieta", "concentracao", "Tempo", "PG"), row.names = c(NA, 6L), class = "data.frame") require(rpanel) #----------------------------------------------------------------------------- myDB <- function(myPanel){ da <<- da.ori; print(head(da)); return(myPanel) } ren_x <- function(myPanel){ var_indep <<- myPanel$var_x colnames(da)[grep(var_indep, colnames(da))] <<- "x" print(colnames(da)); return(myPanel)} ren_y <- function(myPanel){ var_dep <<- myPanel$var_y colnames(da)[grep(var_dep, colnames(da))] <<- "y" print(colnames(da)); return(myPanel)} #----------------------------------------------------------------------------- {myPanel <- rp.control(title = "Adjust", size=c(500,100)) rp.button(myPanel, action=myDB, title="Importar dados / Reiniciar...") # botão importar bd rp.textentry(panel=myPanel, variable=var_y, labels="nome da variável dependente(y):", initval="", action=ren_y) rp.textentry(panel=myPanel, variable=var_x, labels="nome da variável independente(x):", initval="", action=ren_x)} # rp.control.dispose(myPanel) ### </code> ================================================ Éder Comunello Agronomist (UEM), MSc in Environ. Sciences (UEM) DSc in Agricultural Systems Engineering (USP/Esalq) Brazilian Agricultural Research Corporation (Embrapa) Dourados, MS, Brazil |<O>| ================================================ GEO, -22.2752, -54.8182, 408m UTC-04:00 / DST: UTC-03:00
Olá Eder, tudo bem? Desculpe a demora em lhe retornar. Quero lhe agradecer pela atenção. Eu ainda não tinha resolvido esta parte, era exatamente isso que queria. Quando terminar o que estou fazendo compartilharei aqui na lista acredito que poderá se útil a outros Mais uma vez meus sinceros agradecimentos. Em 2 de março de 2016 17:12, Éder Comunello <comunello.eder@gmail.com> escreveu:
Fernando, boa tarde!
Não sei se você já resolveu, mas consegui renomear as variáveis no exemplo que você tinha proposto...
### <code r> ### dados pra testar da.ori <- structure(list(Tubo = c(1L, 1L, 1L, 1L, 1L, 1L), Amostra = c(1L, 1L, 1L, 1L, 1L, 1L), dieta = c(1L, 1L, 1L, 1L, 1L, 1L), concentracao = c(20L, 20L, 20L, 20L, 20L, 20L), Tempo = 1:6, PG = c(4.18, 6.16, 8.13, 9.94, 11.74, 13.72)), .Names = c("Tubo", "Amostra", "dieta", "concentracao", "Tempo", "PG"), row.names = c(NA, 6L), class = "data.frame")
require(rpanel)
#----------------------------------------------------------------------------- myDB <- function(myPanel){ da <<- da.ori; print(head(da)); return(myPanel) }
ren_x <- function(myPanel){ var_indep <<- myPanel$var_x colnames(da)[grep(var_indep, colnames(da))] <<- "x" print(colnames(da)); return(myPanel)}
ren_y <- function(myPanel){ var_dep <<- myPanel$var_y colnames(da)[grep(var_dep, colnames(da))] <<- "y" print(colnames(da)); return(myPanel)}
#-----------------------------------------------------------------------------
{myPanel <- rp.control(title = "Adjust", size=c(500,100))
rp.button(myPanel, action=myDB, title="Importar dados / Reiniciar...") # botão importar bd
rp.textentry(panel=myPanel, variable=var_y, labels="nome da variável dependente(y):", initval="", action=ren_y)
rp.textentry(panel=myPanel, variable=var_x, labels="nome da variável independente(x):", initval="", action=ren_x)}
# rp.control.dispose(myPanel) ### </code>
================================================ Éder Comunello Agronomist (UEM), MSc in Environ. Sciences (UEM) DSc in Agricultural Systems Engineering (USP/Esalq) Brazilian Agricultural Research Corporation (Embrapa) Dourados, MS, Brazil |<O>| ================================================ GEO, -22.2752, -54.8182, 408m UTC-04:00 / DST: UTC-03:00
-- ======================================================================= Fernando Souza Zootecnista, DSc. Produção Animal e-mail:nandodesouza@gmail.com https://producaoanimalcomr.wordpress.com/ ========================================================================
participantes (3)
-
Fernando Antonio de souza -
Walmes Zeviani -
Éder Comunello