====== Código A ====== ################################ # Animação dos Desvios Mínimos # ################################ ##### Código da função ##### anim.msd= function(x, y, lim=1, int=0.05, time=1, cor= "tot", name="animation.gif", xlabel="X", ylabel="Y") # criando o nome da função, os argumentos e seus respectivos defaults { if ((length(grep("animation", library()))==0)=="TRUE") # teste lógico que procura nos pacotes instalados o pacote "animation" que será necessário para rodar a função { stop("Para essa função é necessário instalar o pacote 'animation'(use a função install.packages()) e o software 'ImageMagick' (disponível em http://www.imagemagick.org/script/index.php). Antes de tentar rodar a função novamente, reinicie o programa do R.") # caso o pacote não seja encontrado uma mensagem de aviso é lançada no console } if(length(x) != length(y)) # teste lógigo para a saber se os vetores x e y possuem o mesmo tamanho { stop("x e y não tem o mesmo tamanho") # caso o resultado seja TRUE, uma mensagem de aviso é lançada no console } if(as.numeric(table(is.na(x & y))["FALSE"]) < length(x)) # teste lógico que verifica se o número de "FALSE" em uma tabela que conta os NAs é menor do que o tamanho do objeto x { stop("retire os NA's dos vetores x e/ou y") # caso o resultado do teste seja verdadeiro existem NAs nos dados e uma mensagem de aviso é lançada no console } else # se nenhum dos problemas acima for detectado, a função entra em seu ciclo normal { library(animation) # carrega o pacote "animation" coef= coef(lm(y ~ x)) #calcula e guarda em um objeto os coeficientes do modelo linear de y em função de x intervalo= seq(coef[2]-lim, coef[2]+lim, by=int) # cria uma sequência guardada no objeto "intervalo" a partir do coeficiente de inclinação da regressão com - e + o valor estipulado no argumento "lim" com intervalos de valor do argumento "int", representando quais inclinações aparecerão na animação tam.seg= matrix(NA, length(intervalo), length(y)) #cria uma matriz para guardar o tamanho dos segmentos que representam os desvios para cada reta testada saveGIF( # função que salva os plots e depois converte em GIF, precisa também do software "Imagemagick" como colocado anteriormante { for(i in 1:length(intervalo)) # ciclo para plotar as diferentes retas { plot(y ~ x, xlab=xlabel, ylab=ylabel) #plota as observações com o nome dos eixos points(mean(x), mean(y), col="red", cex=1.5, pch=19) #coloca o ponto de fulcro abline(mean(y)-intervalo[i]*mean(x), intervalo[i]) # acrescenta a reta que passa pelo fulcro e possui a inclinação do "intervalo" daquela rodada (i) y1= (mean(y)-intervalo[i]*mean(x)) + (intervalo[i] * x) # calcula os valores de y da reta para cada x tam.seg[i, ]= abs(y - y1) #calcula o tamanho dos desvios (y observado em relação ao y esperado da reta) e guarda os valores em cada linha da matriz if(cor=="ind") # teste lógico para o argumento "cor==ind", se for verdadeiro para plotar a cor dos segmentos, cada um terá seu tamanho comparado com ele mesmo na rodada anterior { for(j in 1:length(x)) # ciclo para colocar os segmentos dos desvios { if(i==1) # se for a primeira rodada { cores= rep("black", length(x)) # os segmentos terão a cor preta } else # nas outras rodadas as cores serão determinadas por um teste lógico { cores= tam.seg[i, ] >= tam.seg[i-1, ] # teste para saber se o segmento aumentou, permaneceu igual ou diminuiu de tamanho cores[cores==TRUE]= "red" # se verdadeiro a cor será vermelha cores[cores==FALSE]= "green" # se falso a cor será verde } segments(x[j], y[j], x[j], y1[j], col=cores[j]) # acrescenta as linhas dos desvios para o modelo para cada observação com as cores determinadas pelos testes acima } } if(cor=="tot") # teste lógico para o argumento "cor==tot", se for verdadeiro para plotar a cor dos segmentos, será comparada a soma do tamanho dos segmentos de uma rodada com a soma da rodada anterior { for(l in 1:length(x)) # ciclo para colocar os segmentos dos desvios { if(i==1) # se for a primeira rodada { cores= rep("black", length(x)) # os segmentos terão a cor preta } else # nas outras rodadas as cores serão determinadas por um teste lógico { cores= rep(sum(tam.seg[i, ]) >= sum(tam.seg[i-1, ]), length(x)) # teste para saber se a soma dos segmentos aumentou, permaneceu igual ou diminuiu de tamanho cores[cores==TRUE]= "red" # se verdadeiro a cor será vermelha cores[cores==FALSE]= "green" # se falso a cor será verde } segments(x[l], y[l], x[l], y1[l], col=cores[l]) # acrescenta as linhas dos desvios para o modelo para cada observação com as cores determinadas pelos testes acima } } } plot(y ~ x, xlab=xlabel, ylab=ylabel) # plota novamente as observações points(mean(x), mean(y), col="red", cex=1.5, pch=19) #coloca o ponto de fulcro abline(lm(y ~ x), lwd=2, col="blue") # acrescenta a reta da regressão linear (i.e. a de melhor ajuste) }, movie.name=name, interval=c(rep(time, length(intervalo)), 10), nmax=50, ani.width=600, ani.height=600) # fecha o ciclo da animação e determina o nome que será dado, a duração entre os "frames" e o tamanho da janela que será criada } return(summary(lm(y ~ x))) # retorna um sumário da regressão linear de y em função de x } # fim da função