##----------------------------------------------------------------------------- ## Definções do knitr. Não rodar. opts_chunk$set( cache=FALSE, tidy=FALSE, fig.width=6, fig.height=4.5, fig.align="center", dpi=100, dev="png", dev.args=list(png=list(family="Ubuntu Light", type="cairo"))) options(width=90) ##============================================================================= ## Curso de Estatística Experimental com aplicações em R ## 12 à 14 de Novembro - Manaus/AM ## Embrapa Amazônia Ocidental ## ## Prof. Walmes Zeviani ## LEG - DEST - UFPR ##============================================================================= ##----------------------------------------------------------------------------- ## Dados de carros Duster à venda no webmotors em 26/03/2014. dus <- read.table("http://www.leg.ufpr.br/~walmes/data/duster_venda_260314.txt", header=TRUE, sep="\t", encoding="utf-8") ## dus <- ## read.table("/home/walmes/Dropbox/XML-leituras/carros/duster_venda_260314.txt", ## header=TRUE, sep="\t", encoding="utf-8") dus$ano <- factor(gsub(x=as.character(dus$ano), "/\\d{4}$", "")) str(dus) ## Quantidade de NA em cada coluna. apply(dus, MARGIN=2, function(x) sum(is.na(x))) ## Elimina registros com NA. dus <- na.omit(dus) str(dus) ##----------------------------------------------------------------------------- ## Gráfico de barras e setores. x <- table(dus$cambio) class(x) ## Se vem da xtabs() também tem classe `table`. x <- xtabs(~cambio, data=dus) class(x) ## barplot(x) barplot(x, xlab="Tipo de câmbio", ylab="Frequência absoluta", col=c("seagreen", "yellowgreen")) barplot(x, horiz=TRUE, xlab="Tipo de câmbio", ylab="Frequência absoluta", col=c("seagreen", "yellowgreen")) box(bty="L") ## Cores com `green` no nome. colors() grep("green", colors(), value=TRUE) ## Gráfico de setores. pie(x, col=c("seagreen", "yellowgreen"), main="Tipo de câmbio") ## Para as cores do carro. x <- xtabs(~cor, data=dus) levels(dus$cor) par(mar=c(4.1,7.1,2.1,2.1)) barplot(x, horiz=TRUE, las=1, col=c("blue", "white", "gray50", "Yellow", "gray90", "black", "green4", "red", "red4")) mtext(side=2, text="Cor", line=5) mtext(side=1, text="Frequência absoluta", line=2) box(bty="L") ##----------------------------------------------------------------------------- ## Gráficos de barras emplilhadas (stacked) e lado a lado. x <- xtabs(~ano+cambio, data=dus) x ## Barras empilhadas. barplot(x, xlab="Câmbio", ylab="Frequência absoluta") colcamb <- c("seagreen", "yellowgreen") barplot(t(x), xlab="Ano", ylab="Frequência absoluta", col=colcamb) legend("topleft", legend=levels(dus$cambio), fill=colcamb, bty="n") ## Barras lado a lado. barplot(t(x), beside=TRUE, xlab="Ano", ylab="Frequência absoluta", col=colcamb) legend("topleft", legend=levels(dus$cambio), fill=colcamb, bty="n") ##----------------------------------------------------------------------------- ## Anotações nas barras. x <- xtabs(~cambio+poten, data=dus); x ## Cores de preenchimento para as barras. cols <- c("seagreen", "yellowgreen") ## Barras lado a lado. bp <- barplot(t(x), beside=TRUE, col=cols, xlab="Tipo de câmbio", ylab="Frequência absoluta") bp ## Calcula a altura de uma palavra em termos da escala y do gráfico. sh <- strheight("um texto qualquer"); sh lim <- par()$usr[4]+3*sh ## Refaz o gráfico com espaço para o texto. barplot(t(x), beside=TRUE, col=cols, ylim=c(0, lim), xlab="Tipo de câmbio", ylab="Frequência absoluta") legend("topleft", title="Potência", legend=c("1.6","2.0"), fill=cols, bty="n") text(x=c(bp), y=t(x), labels=t(x), pos=3) box() ##----------------------------------------------------------------------------- ## Gráficos de mosaico. x <- xtabs(~ano+cambio, data=dus) x mosaicplot(x, ylab="Tipo de câmbio", xlab="Ano") mosaicplot(t(x), xlab="Tipo de câmbio", ylab="Ano") x <- xtabs(~novo+poten, data=dus); x ## Não dependência entre as variáveis. mosaicplot(x, xlab="Condição", ylab="Potência", col=c("#009054","#900039")) mosaicplot(HairEyeColor) a <- apply(HairEyeColor, c(1,2), sum) mosaicplot(a) mosaicplot(t(a)) ## Pode-se especificar cores com a trinca RGB (red, green, blue), ## pode-se usar o padrão hexadecimal html para cores. ## Visite estes sites para pegar cores. ## browseURL("http://www.w3schools.com/html/html_colors.asp") ## browseURL("http://html-color-codes.info/") ##----------------------------------------------------------------------------- ## Histograma. hist(dus$valor) hist(dus$valor, xlab="Preço de venda (R$)", ylab="Frequência absoluta", col="orange") rug(dus$valor) ## Se breaks é um escalar então entende-se que é uma *sugestão* para o ## número de clases. hist(dus$valor, breaks=15, xlab="Preço de venda (R$)", ylab="Frequência absoluta", col="orange") rug(dus$valor) ## Se breaks é um vetor então entende-se que são os limites para ## classificação dos valores. hist(dus$valor, breaks=seq(35000, 75000, 2500), xlab="Preço de venda (R$)", ylab="Frequência absoluta", col="#7700B7", sub="Amplitude de classe de R$ 2500", main=NULL) ## Gráfico onde a altura é a densidade e não a frequência. hist(dus$valor, prob=TRUE, breaks=seq(35000, 75000, 2500), xlab="Preço de venda (R$)", ylab="Frequência absoluta", col="#7700B7", sub="Amplitude de classe de R$ 2500", main=NULL) ## Esse gráfico tem que a soma da área dos retângulos somam 1 pois o ## produto da amplitude pela densidade é a frequência relativa e a soma ## das frequência relativas é 1. hist(dus$valor, prob=TRUE, seq(35000, 75000, 2000), xlab="Preço de venda (R$)", ylab="Frequência absoluta", col="#6E0039", sub="Amplitude de classe de R$ 2500", main=NULL) rug(dus$valor) ## Faz risquinhos no eixo x. ##----------------------------------------------------------------------------- ## Anotações sobre um histograma. ## Com domínio do R se pode fazer gráficos espetaculares, como por ## exemplo esse com variação da tonalidade. ht <- hist(dus$valor, prob=TRUE, breaks=seq(35000, 75000, 2000), xlab="Preço de venda (R$)", ylab="Frequência absoluta", col="#6E0039", sub="Amplitude de classe de R$ 2500") rug(dus$valor) ## Faz risquinhos no eixo x. ## Destacar a barra da classe modal usando outra cor. wm <- which.max(ht$counts) cols <- rep("yellow", length(ht$counts)) cols[wm] <- "red" cols plot(ht, col=cols) ## Traçar os segmentos que indicam o valor interpolado para a moda. ycoor <- with(ht, counts[wm+0:1]) xcoor <- with(ht, breaks[wm+0:1]) segments(xcoor[1], ycoor[1], xcoor[2], ycoor[2]) ycoor <- with(ht, counts[wm-1:0]) xcoor <- with(ht, breaks[wm+0:1]) segments(xcoor[1], ycoor[1], xcoor[2], ycoor[2]) ## Por semelhança de triangulos a moda obtida é: ac <- with(ht, diff(breaks[1:2])) d <- with(ht, abs(diff(counts[wm+(-1:1)]))) xmoda <- with(ht, breaks[wm]+(ac*d[1])/sum(d)); xmoda abline(v=mean(dus$valor)) abline(v=xmoda, col="yellow") ## Como aprimorar um histograma. plot(ht, col=NULL, lty=0, ann=FALSE, axes=FALSE) abline(h=seq(0, 100, by=10), lty=2) plot(ht, col=cols, ann=FALSE, axes=FALSE, add=TRUE) rug(dus$valor) axis(side=1, at=seq(35000, 75000, 5000)) axis(side=2, at=seq(0, 100, by=10)) box(bty="L") title(main="Histograma do valor (R$)", sub="Dados retirados do webmotors.com", xlab="Valor (R$)", ylab="Frequência absoluta") mtext(side=3, line=0, text=paste("Amostra de tamanho", length(dus$valor))) mtext(side=4, line=-1, col="gray70", outer=TRUE, adj=0, text="Feito por Walmes Zeviani") legend("topright", fill="red", legend="Classe modal", bty="n") ## Outra variação de um histograma. ht <- hist(dus$valor, seq(35000, 75000, 2000), plot=FALSE) nc <- length(ht$mids) ## Número de classes. ac <- diff(ht$breaks[1:2]) ## Amplitude de classe. ma <- mean(dus$valor) ## Média da amostra. md <- median(dus$valor) ## Mediana da amostra. qts <- fivenum(dus$valor)[c(2,4)] ## 1Q e 3Q da amostra. modal <- which.max(ht$counts) ## Classe modal. modal <- list(x=ht$mids[modal], y=ht$counts[modal]) colseq <- rgb(red=0.25, blue=0.7, green=seq(0.1, 0.9, length.out=nc)) plot(ht, col=colseq, ylim=c(0, modal$y+strheight("1")), xlab="Preço de venda (R$)", ylab="Frequência absoluta", sub=paste("Amplitude de classe de R$", ac), main=NULL, border="gray50") text(x=modal$x, y=modal$y, labels=modal$y, pos=3) rug(dus$valor) arrows(ma, 0, ma, modal$y/3, code=1, length=0.15) text(ma, modal$y/3, labels=paste("Média:", round(ma,2)), pos=3) arrows(md, 0, md, modal$y/6, code=1, length=0.15) text(ma, modal$y/6, labels=paste("Mediana:", round(md,1)), pos=ifelse(md