[R-br] função de interpolação
Fernando Souza
nandodesouza em gmail.com
Quinta Outubro 2 22:49:22 BRT 2014
Olá Jônatan. Muito obrigado era exatamente isso que queria. Uma
interpolação mais flexível. tenho uma banco de dados muito grande e
fazer tudo isso na mão seria muito dispendioso. Irei estudar seu código
para compreender e absorver este conhecimento.
Aproveitando quero também agradecer ao Benilton pela ajuda, que me me
será útil em outro banco de dados que possuo.
Meus sinceros agradecimentos
On 02-10-2014 22:22, Jônatan wrote:
> Pelo que entendi, tu queres ter um peso interpolado para cada dia
> entre o período de medidas de peso de cada animal?
>
> dados3 <- droplevels(dados2)
> ## lista com dados divididos por animal
> s <- split(x = dados3, f = dados3$Animal)
>
> ## looping para na série de cada animal
> l <- lapply(s, function(x) {
> # x <- s[[1]]
> print(unique(as.character(x$Animal)))
> x0 <- subset(x, sel = c("Data", "Animal", "Peso"))
> ## datas de referência, desde o primeiro dia ao
> último com peso
> dref <- data.frame(Data = seq(min(x$Data),
> max(x$Data),
> by = "days"))
> ## gera série de pesos com NAs para as datas sem
> medida
> m <- merge(dref, x, all = T)
> ## repete o ID do animal
> m$Animal <- sort(unique(m$Animal))
> ## interpola peso para cada dia do período
> entre a 1a e última medida
> m$Peso_int <- approx(x = m$Data,
> y = m$Peso,
> xout = m$Data)$y
> m
> }# end fun
> )# end lapply
>
> res <- ldply(l)
>
>
> 2014-10-02 21:57 GMT-03:00 Fernando Souza <nandodesouza em gmail.com
> <mailto:nandodesouza em gmail.com>>:
>
> É o seguinte. Os dados que tenho são de pesagens de animais . Em
> geral estas pesagens são feitas a intervalos fixos (por exemplo a
> cada 15 dias). sendo assim para estimar os pesos diários entre
> duas pesagens eu pretendo interpolar 13 valores entre as medidas.
> Acontece que nestes dados nas pesagens não ocorreram em intervalos
> fixos e sendo assim para o animal 1 por e xemplo para a pesagem na
> data 1 e pesagem na data 2 tenho intervalo de 13 dias, entre a
> pesagem na data 2 e pesagem na data 3 tenho 10 dias de intervalo e
> o mesmo ocorre para outros animais. Na função approx(x,y,n) é
> possível definir o número de valores interpolados no argumento n.
> O default é 50, ou seja ele interpola 50 dados entre dois pares
> (x1,y1) (x2,y2) e 50 dados para os pares (x2,y2)(x3,y3). Acontece
> que se no intervalo deste último par de coodernada (ond x(i) é
> data) necessitar de 20 valores (intervalo de 20 dias) eu não tenho
> como controlar, pois será gerado 50 dados. Por isso estou pensando
> em uma forma de ler o intervalo entre duas coordenadas (x,y) e
> fornecer este valor para o agumento n da função approx.
>
> Pois da forma como está sendo interpolado para alguns animais
> tenho de deletar valores enquanto em outros terei de adicionar mais.
>
> Att
>
> On 02-10-2014 19:47, Benilton Carvalho wrote:
>>
>> Oi Fernando, o problema é que não entendo o que é o valor de n
>> que vc quer para cada caso. b
>>
>> On Oct 2, 2014 4:16 PM, "Fernando Souza" <nandodesouza em gmail.com
>> <mailto:nandodesouza em gmail.com>> wrote:
>>
>> 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.
>>
>>
>>
>> _______________________________________________
>> 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/c3f975df/attachment-0001.html>
Mais detalhes sobre a lista de discussão R-br