Universidade Federal do Paraná
Curso de Estatística
CE 083 -
Estatística Computacional I - 2014/2
Prof. Dr. Walmes Marques Zeviani
Tabela de conteúdo
##-----------------------------------------------------------------------------
## Funções gráficas de baixo nível para adicionar geometria e texto à
## gráficos.
## * points : pontos.
## * lines : linhas (pontos unidos por linhas).
## * abline : linhas (infinitas, de fora a fora).
## * segments : segmentos de reta (finitos, de a até b).
## * arrows : segmentos de reta com ponteira.
## * rect : retângulos (podem ser preenchidos).
## * polygon : polígonos (podem ser preenchidos).
## * text : dentro dentro da área gráfica.
## * mtext : texto nas margens do gráficos.
## * title : título, subtítulo e escrita dos rótulos.
## * axis : edição dos eixos do gráfico, escalas e rótulos.
## * legend : legenda.
## * grid : malha de referência dentro do gráfico.
## * box : caixa ao redor do gráfico.
##-----------------------------------------------------------------------------
## 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")
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)
##-----------------------------------------------------------------------------
## Escrevendo sobre as barras do gráfico.
x <- xtabs(~cambio, data=dus)
bp <- barplot(x, xlab="Tipo de câmbio",
ylab="Frequência absoluta",
col=c("seagreen", "yellowgreen"))
bp
## Acrescenta texto ao gráfico que está aberto.
text(x=c(bp), y=x, labels=x, pos=3)
## Pega os limites das dimensões, em x e y, do último gráfico feito.
lim <- par()$usr[4]
## Refaz o gráfico agora com espaço para o texto a ser adicionado.
barplot(x, xlab="Tipo de câmbio",
ylab="Frequência absoluta",
col=c("seagreen", "yellowgreen"),
ylim=c(0, lim*1.1))
text(x=c(bp), y=x, labels=x, pos=3)
box()
##-----------------------------------------------------------------------------
## Texto em barras lado a lado.
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
## Adiciona uma legenda.
legend("topleft", legend=c("1.6","2.0"), fill=cols)
## Adiciona o texto sobre as barras.
text(x=c(bp), y=t(x), labels=x, pos=3)
## 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", legend=c("1.6","2.0"), fill=cols, bty="n")
text(x=c(bp), y=t(x), labels=x, pos=3)
box()
##-----------------------------------------------------------------------------
## Anotações sobre um histograma.
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<ma, 2, 4))
box()
##-----------------------------------------------------------------------------
## Gráfico de densidade.
den <- density(dus$valor)
str(den)
plot(den)
modal <- which.max(den$y)
modal <- list(x=den$x[modal], y=den$y[modal])
plot(den, type="n", xlab="Preço de venda (R$)", ylab="Densidade",
ylim=c(0, modal$y+strheight("1")), main="",
sub=paste("Bandwidth:", round(den$bw,3)))
with(den, polygon(x, y, col="gray90"))
with(modal, segments(x, 0, x, y, col=2))
with(modal, text(x, y, labels=round(x, 2), pos=3))
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<ma, 2, 4))
rug(dus$valor)
##-----------------------------------------------------------------------------
## Diagrama de dispersão.
## Adicionar uma linha de tendência suave e um grid.
plot(valor~km, data=dus,
xlab="Distância percorrida (km)",
ylab="Preço de venda (R$)")
with(dus, lines(lowess(x=km, y=valor), lwd=2))
grid()
## Usar cores diferentes para identificar o tipo de câmbio.
plot(valor~km, data=dus, col=c(2,4)[dus$cambio],
xlab="Distância percorrida (km)",
ylab="Preço de venda (R$)")
with(subset(dus, cambio=="AUTOMÁTICO"),
lines(lowess(x=km, y=valor), col=2, lwd=1.5,))
with(subset(dus, cambio=="MANUAL"),
lines(lowess(x=km, y=valor), col=4, lwd=1.5,))
legend("topright", lty=1, col=c(2,4), lwd=1.5,
legend=levels(dus$cambio), bty="n")
grid()
##-----------------------------------------------------------------------------
## Box-plot com os valores da média indicados.
levels(dus$cat)
levels(dus$cat) <- c("?", "Dynamique", "Expression",
"Tech Road I", "Tech Road II")
mds <- with(dus, tapply(valor, cat, mean))
boxplot(valor~cat, data=dus,
xlab="Modelo", ylab="Preço de venda (R$)")
points(x=1:nlevels(dus$cat), y=mds, pch=15, cex=1.5)
##-----------------------------------------------------------------------------
## Gráficos com o valor para a média e barra de erro para o
## desvio-padrão.
res <- aggregate(valor~cat, data=dus,
FUN=function(x){ c(m=mean(x), s=sd(x)) })
## Criando os limites superior e inferior.
res <- transform(res,
lwr=valor[,1]-valor[,2],
upr=valor[,1]+valor[,2],
catf=as.integer(cat))
res
with(res, matplot(x=catf, y=cbind(lwr, upr),
xlim=extendrange(x=catf, f=0.1),
ylim=extendrange(x=c(lwr, upr), f=0.1),
type="n", ann=FALSE, xaxt="n"))
grid()
with(res, points(x=catf, y=valor[,"m"], pch=19))
with(res, arrows(catf, lwr, catf, upr, code=3,
angle=90, length=0.1))
with(res, axis(side=1, at=catf, labels=as.character(cat)))
title(xlab="Categoria", ylab="Valor (R$)")
mtext(side=3, line=0,
text=expression("Barras de erro representam "*bar(x) %+-% 1*s))
## Com o boxplot ao lado.
with(res, matplot(x=catf, y=cbind(lwr, upr),
xlim=extendrange(x=catf, f=0.1),
ylim=extendrange(x=c(lwr, upr, dus$valor), f=0.1),
type="n", ann=FALSE, xaxt="n"))
grid()
with(res, points(x=catf, y=valor[,"m"], pch=19))
with(res, arrows(catf, lwr, catf, upr, code=3,
angle=90, length=0.1))
with(res, axis(side=1, at=catf, labels=as.character(cat)))
title(xlab="Categoria", ylab="Valor (R$)")
mtext(side=3, line=0,
text=expression("Barras de erro representam "*bar(x) %+-% 1*s))
boxplot(valor~cat,
at=1:nlevels(dus$cat)+0.2, col="gray45",
data=dus, add=TRUE, ann=FALSE, axes=FALSE,
pars=list(boxwex=0.1))
## Com boxplot e pontos dispersos dos lados.
xlim <- extendrange(x=1:nlevels(dus$cat), f=0.1)
ylim <- extendrange(x=c(res$lwr, res$upr, dus$valor), f=0.1)
par(mar=c(5.1,4.1,4.1,0))
layout(matrix(c(1,2), ncol=2), widths=c(0.85,0.15))
with(dus,
plot.default(
x=jitter(as.integer(cat), factor=0.25)-0.2,
y=valor, xaxt="n", ann=FALSE, col="gray50",
xlim=xlim, ylim=ylim))
grid()
with(res, points(x=catf, y=valor[,"m"], pch=19))
with(res, arrows(catf, lwr, catf, upr, code=3,
angle=90, length=0.05))
with(res, axis(side=1, at=catf, labels=as.character(cat), cex.axis=0.95))
title(xlab="Categoria", ylab="Valor (R$)")
mtext(side=3, line=0,
text=expression("Barras de erro representam "*bar(x) %+-% 1*s))
boxplot(valor~cat,
at=1:nlevels(dus$cat)+0.2, col="gray45",
data=dus, add=TRUE, ann=FALSE, axes=FALSE,
pars=list(boxwex=0.1))
par(mar=c(5.1,0.1,4.1,1))
yhist <- hist(dus$valor, plot=FALSE, breaks=20)
str(yhist)
with(yhist,
plot(x=NULL, y=NULL, ann=FALSE, axes=FALSE,
ylim=ylim, xlim=c(0, max(density))))
rug(side=2, dus$valor)
snc <- 1:length(yhist$mids)
with(yhist,
rect(0, breaks[snc],
density[snc], breaks[snc+1],
col="gray70"))
den <- density(dus$valor)
with(den, lines(x=y, y=x, col="red", lwd=2))
