[R-br] função de interpolação
Fernando Souza
nandodesouza em gmail.com
Quinta Outubro 2 16:41:43 BRT 2014
Obrigado pela atenção
Essa conversão eu consegui fazer. O código gera o dataframe da forma
como quero o meu problema é conseguir gerar o número de observações
correta para cada intervalo entre observações para que a quantidade de
valores gerados coincida com o restante do banco de dados que possuo
On 02-10-2014 16:37, Jônatan wrote:
> Para parte final do seu script ("Conversão da lista Res para
> dataframe") acho (não testado nos seus dados) que com um df <-
> melt(res) você converte para dataframe. A função melt está disponível
> no pacote reshape2.
>
>
> 2014-10-02 16:15 GMT-03:00 Fernando Souza <nandodesouza em gmail.com
> <mailto:nandodesouza em gmail.com>>:
>
> Caro Benilton, tudo bem?
> O código que você me passou fez exatamente o que eu queria, mas
> estou tendo o seguinte problema.
> Na função approx () eu determino o número de medidas fixas (n)
> entre observações. No entanto eu tenho número de observações
> diferentes entre animais e intervalo entre observações diferentes.
> Por exemplo: Animal 1 possuo 4 pesagens intervaladas de 10 dias
> (ou seja 40 observações) ,animal 2 tenho 3 pesagens intervaladas
> 15 dias (75 observações) etc... e sendo assim ao determinar um
> número fixo (n) p.ex aprrox(x,y,n=15) eu terei 60 observações para
> o animal 1 (excedente de 10) e 75 observações animais 2 (exato)
>
> Eu estou pensando em uma função que pudesse alterar o valor de n
> para cada intervalo entre observações. Como é possível fazer isso
>
> dados2<-structure(list(Animal = structure(c(1L, 1L, 1L, 1L, 1L,
> 1L, 8L,
> 8L, 8L, 16L, 16L, 16L, 16L, 16L, 16L, 24L, 24L, 24L, 34L, 34L,
> 34L, 37L, 37L, 37L, 37L, 37L, 37L), .Label = c("1", "12", "14",
> "15", "17", "18", "19", "2", "21", "22", "23", "25", "26", "*27",
> "28", "3", "30", "32", "34", "35", "37", "38", "39", "4", "40",
> "41", "42", "43", "44", "46", "47", "48", "49", "5", "50", "53",
> "7", "8", "9"), class = "factor"), Gest = c(140L, 140L, 140L,
> 140L, 140L, 140L, 100L, 100L, 100L, 130L, 130L, 130L, 130L, 130L,
> 130L, 100L, 100L, 100L, 100L, 100L, 100L, 140L, 140L, 140L, 140L,
> 140L, 140L), Manej = c(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), Data = structure(c(-715270, -715256, -715241, -715228, -715214,
> -715193, -715270, -715256, -715235, -715270, -715256, -715241,
> -715228, -715214, -715200, -715270, -715256, -715235, -715270,
> -715256, -715235, -715270, -715256, -715241, -715228, -715214,
> -715193), class = "Date"), IntervaloPeso = c(14L, 15L, 13L, 14L,
> 21L, 0L, 14L, 21L, 0L, 14L, 15L, 13L, 14L, 14L, 0L, 14L, 21L,
> 0L, 14L, 21L, 0L, 14L, 15L, 13L, 14L, 21L, 0L), Peso = c(37,
> 38.2, 41, 42.9, 43, 49, 40, 41.8, 40.8, 38, 39.9, 41.9, 45.2,
> 46.2, 51.8, 40, 40.9, 41.9, 32.3, 34.9, 35, 35.1, 36.5, 35.2,
> 38.3, 38, 40.5)), .Names = c("Animal", "Gest", "Manej", "Data",
> "IntervaloPeso", "Peso"), row.names = c(NA, 27L), class =
> "data.frame")
>
> library(plyr)
> library(zoo)
> intervalo<- ddply(dados2, .(Animal), summarise, intervalo =
> diff(Data)) #intervalo entre medidas
> n_observacao<- as.vector(table(dados2$Animal)) #nunero de
> observações em cada animal
> #----------------------------------------------------------------------------------------------------------------------------
> #isso é que esto tentando fazer ! mas não funciona
> myf2<-function(mydf,intervalo){
> + for(i in 1:length(intervalo$periodo)){
> + approx(mydf$Data,mydf$Peso,n=intervalo$periodo[i])}
> }
> res <- dlply(dados2, .(Animal), myf2)
>
> #-----------------------------------------------------------------------------------------------
> Exemplo do Benilton, n fixo igual a 15
>
> myf <- function(mydf)
> with(mydf, approx(Data, Peso,n= 15)) #esta funçao realiza
> a interpolaçao agrupada por animal
>
> res <- dlply(dados2, .(Animal), myf)
>
>
>
> #------------------------------------Conversão da lista Res para
> dataframe--------------------------------------------------------------------------------------
>
> df<-data.frame(Data=unlist(sapply(res, "[",
> 1)),Peso=unlist(sapply(res,"[",2))) #remove os dados da lista e o
> converte em data frame
> ID<-row.names(df)#captura os nomes das linhas do data frame
> df<-cbind(ID,df)#adiciona os nomes da linha como coluna de
> identificaçao
> row.names(df)<-NULL#remove nome das linhas
> df$Data<-as.Date(df$Data) #base de dados com formato de data corrigida
> df$Animal<-factor(rep(unique(levels(dados2$Animal)),each=50))
>
> On 01-10-2014 15:50, Benilton Carvalho wrote:
>> Oi Fernando,
>>
>> alguns comentarios antes.... Quando vc diz de interpolar, vc quer
>> "peso" como sendo sua variavel "Y" e "dia/data/etc" como eixo
>> "X"... correto?
>>
>> Se for este o caso, a sua chamada de 'approx' esta' incorreta...
>> o "X" e' o primeiro argumento... e o "Y" e' o segundo.
>>
>> Alem disso, no codigo abaixo, colocarei a interpolacao para
>> funcionar direto das datas... se isso vai fazer sentido (ou nao),
>> deixo pra vc "descobrir" (a dica e' que o R vai achar uma
>> representacao numerica para data e converte-la antes do ajuste...
>> experimente um pouco e veja se e' conveniente para o seu caso. Se
>> nao for, crie a variavel adequada a priori).
>>
>> Usando o seu conjunto de dados de exemplo (colado abaixo apenas
>> para conveniencia):
>>
>> set.seed(20)
>> dados<-data.frame(ANIMAL=factor(rep(1:5,each=4)),
>> Peso=rnorm(20,30,4),
>> data=sample(seq(as.Date("01/04/2009",'%d/%m/%Y'),
>> as.Date("30/04/2009",'%d/%m/%Y'),length.out=30), 20),
>> day=1:20)
>>
>> Tudo o que vc precisa e' criar uma funcao que funcione num
>> data.frame de mesma estrutura que este acima.... Veja o codigo
>> abaixo:
>>
>> myf <- function(mydf)
>> with(mydf, approx(data, Peso))
>>
>> Tudo o que a funcao 'myf' faz e' a interpolacao Peso x data num
>> data.frame generico chamado 'mydf'... Note que a funcao e' burra
>> o suficiente pra nao saber que existem animais diferentes... mas
>> se vc tivesse um data.frame para cada animal, isso funcionaria...
>>
>> Entao agora e' dividir os data.frames por animal e ter os
>> resultados... Para isso, eu gosto de usar o pacote 'plyr'... Como
>> a entrada de dados e' a partir de um data.frame (d) e a saida eu
>> quero que seja numa lista (l), entao vc usa o comando 'dlply'...
>>
>> library(plyr)
>> res <- dlply(dados, .(ANIMAL), myf)
>>
>> Por fim, o que isso faz e': pegar o seu data.frame completo,
>> quebrar em data.frames menores usando a variavel 'ANIMAL' e, em
>> cada data.frame menor, aplicar a funcao 'myf'.... Seu resultado
>> 'res', e' uma lista... cada elemento da lista e' um resultado do
>> approx para cada animal...
>>
>> b
>>
>>
>> set.seed(20)
>> dados<-data.frame(ANIMAL=factor(rep(1:5,each=4)),
>> Peso=rnorm(20,30,4),
>> data=sample(seq(as.Date("01/04/2009",'%d/%m/%Y'),
>> as.Date("30/04/2009",'%d/%m/%Y'),length.out=30), 20),
>> day=1:20)
>> myf <- function(mydf)
>> with(mydf, approx(data, Peso))
>> library(plyr)
>> res <- dlply(dados, .(ANIMAL), myf)
>>
>>
>>
>> Em 1 de outubro de 2014 14:16, Fernando Souza
>> <nandodesouza em gmail.com <mailto:nandodesouza em gmail.com>> escreveu:
>>
>> Caros amigos
>>
>> Estou necessitando faze a interpolação de algumas pesagens
>> tomadas em diferentes animais. Eu preciso da interpolação
>> feita para cada animal separadamente e o intervalo entre
>> medidas não é fixo. Eu estou utilizando a função approx() no
>> entanto devido ao número de animais utilizados fica muito
>> dispendioso fazer fazer esta interpolação uma a uma. Por
>> isso gostaria de uma função onde um pudesse automatizar este
>> procedimento.
>>
>> set.seed(20)
>> dados<-data.frame(ANIMAL=factor(rep(1:5,each=4)),Peso=rnorm(20,30,4),
>> data=sample(seq(as.Date("01/04/2009",'%d/%m/%Y'),
>> as.Date("30/04/2009",'%d/%m/%Y'),length.out=30),20),day=1:20)
>>
>> Estou tentando fazer uma função que estime os pontos da
>> interpolação agrupados por Animal . Entretanto tenho pouco
>> conhecimento em programação para fazer isso. Tenho tentado
>> fazer isso, sem muito sucesso.
>> Alguém poderia me ajudar? Abraços
>>
>> aprendendo<-function(dados){
>> niveis<-levels(dados$ANIMAL)
>> dia<-diff(dados$data)
>> for(i in min(niveis):max(niveis)){
>>
>> b<-
>> approx(dados[dados$ANIMAL==as.numeric(i),]$Peso,dados[dados$ANIMAL==as.numeric(i),]$data),n=15)
>> }
>> return(b)
>> }
>> _______________________________________________
>> R-br mailing list
>> R-br em listas.c3sl.ufpr.br <mailto:R-br em 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.
>>
>>
>>
>>
>> _______________________________________________
>> R-br mailing list
>> R-br em listas.c3sl.ufpr.br <mailto:R-br em 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.
>
>
> _______________________________________________
> R-br mailing list
> R-br em listas.c3sl.ufpr.br <mailto:R-br em 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.
>
>
>
>
> --
> ###############################################################
> ## Jônatan Dupont Tatsch
> ## Professor do Departamento de Física
> ## Centro de Ciências Exatas e Naturais (CCNE)
> ## Universidade Federal de Santa Maria
> ## Faixa de Camobi, Prédio 13 - Campus UFSM - Santa Maria, RS, Brasil
> - 97105-900
> ## Telefone: +55(55)33012083
> ## www.ufsm.br/meteorologia <http://www.ufsm.br/meteorologia>
> ###############################################################
>
>
> _______________________________________________
> R-br mailing list
> R-br em 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.
-------------- Próxima Parte ----------
Um anexo em HTML foi limpo...
URL: <http://listas.inf.ufpr.br/pipermail/r-br/attachments/20141002/155eea79/attachment-0001.html>
Mais detalhes sobre a lista de discussão R-br