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
##-----------------------------------------------------------------------------
## Lendo os arquivos de dados.
setwd("/home/walmes/Dropbox/XML-leituras/carros2/")
list.files(pattern="^aval.*\\.(txt|csv)$")
## Notas no formato longo (emplilhado nos itens).
nt <- read.table("aval_carros_nota.txt",
header=TRUE, sep="\t")
str(nt)
head(nt)
## Informações de cada dono/veículo.
dn <- read.table("aval_carros_info.csv",
header=TRUE, sep=";",
stringsAsFactors=FALSE)
str(dn)
head(dn)
## Dicionário com nomes e comprimentos dos campos.
dic <- read.table("aval_carros_dic.txt",
header=FALSE, sep="\t",
stringsAsFactors=FALSE)
str(dic)
head(dic)
## Notas no formato amplo em arquivo de comprimento de campo fixo.
ntw <- read.fwf("aval_carros_fwf.txt",
widths=dic$V2)
names(ntw) <- dic$V1
str(ntw)
## Removendo os espaços extras na posta das strings.
levels(ntw$carro) <- gsub("^\\s*", "", levels(ntw$carro))
head(ntw)
##-----------------------------------------------------------------------------
## Selecionar um par de carros e filtrar em cada tabela.
sel <- c("fox","gol")
## nt <- droplevels(subset(nt, is.element(carro, sel)))
nt <- droplevels(subset(nt, carro%in%sel))
str(nt)
dn <- droplevels(subset(dn, carro%in%sel))
str(dn)
ntw <- droplevels(subset(ntw, carro%in%sel))
str(ntw)
##-----------------------------------------------------------------------------
## Gráficos da biblioteca lattice.
require(lattice)
## Loading required package: lattice
require(latticeExtra)
## Loading required package: latticeExtra
## Loading required package: RColorBrewer
## Histograma.
## histogram(~nota|item, data=nt)
histogram(~nota|item, data=nt, breaks=0:11-0.5)
col2rgb(col="seagreen")
col2rgb(col="purple")
histogram(~nota|item, data=subset(nt, carro=="fox"),
breaks=0:11-0.5, main="Fox", col="seagreen")
histogram(~nota|item, data=subset(nt, carro=="gol"),
breaks=0:11-0.5, main="Gol", col="purple")
dput(round(c(col2rgb(col="seagreen")/255), 4))
dput(round(c(col2rgb(col="purple")/255), 4))
## Cores com transparência.
cols <- c(rgb(0.1804, 0.5451, 0.3412, alpha=0.25),
rgb(0.6275, 0.1255, 0.9412, alpha=0.25))
## Apesar dos esforços, ainda não fica tão bom.
histogram(~nota|item, data=subset(nt, carro=="fox"),
breaks=0:11-0.5, main="Fox", col=cols[1])+
as.layer(
histogram(~nota|item, data=subset(nt, carro=="gol"),
breaks=0:11-0.5, main="Gol", col=cols[2]))
## Trocar o histograma por pontos que representam a frequência.
## Uma tabela de frequência flat entre ocorrências de nota para item em
## cada carro.
xt <- xtabs(~item+carro+nota, nt)
str(xt)
ftbl <- ftable(xt); ftbl
## Convertendo em data.frame.
tb <- as.data.frame(ftbl)
str(tb)
## Dividir pela frequência marginal de cada carro.
xtabs(~carro, ntw)
fm <- ave(tb$Freq, tb$carro, FUN=sum)/nlevels(tb$item)
head(fm)
## A soma das frequências relativas da 1.
tb$FreqRel <- tb$Freq/fm
with(tb, tapply(FreqRel, list(item, carro), FUN=sum))
## Se sobrepõem. Adicionar descolamento para mais e menos ajudaria.
xyplot(FreqRel~nota|item, groups=carro, data=tb)
## Adicionando deslocamento.
tb$nota <- as.integer(as.character(tb$nota))-
(0.2*(as.integer(tb$carro)-
median(c(1, nlevels(tb$carro)))
)
)
xyplot(FreqRel~nota|item, groups=carro, data=tb,
type="h", lwd=2, auto.key=list(lines=TRUE, points=FALSE))
##-----------------------------------------------------------------------------
## Distribuição de frequências acumuladas.
str(tb)
ecdfplot(~nota|item, groups=carro, data=nt,
auto.key=TRUE)
##-----------------------------------------------------------------------------
## Gráfico de caixas.
## 1) Cuidado: os dados são discretos e limitados!.
bwplot(nota~carro|item, data=nt, pch="|")
bwplot(carro~nota|item, data=nt, pch="|", horiz=TRUE)
xyplot(Consumo~Motor, data=ntw, jitter.x=TRUE, jitter.y=TRUE)
xyplot(Consumo~Motor|carro, data=ntw, jitter.x=TRUE, jitter.y=TRUE)
xyplot(Consumo~Motor|carro, data=ntw, jitter.x=TRUE, jitter.y=TRUE,
type=c("p","smooth"))
xtb <- xtabs(~Consumo+Motor+carro, data=ntw)
## levelplot(xtb)
levelplot(xtb, col.regions=gray.colors)
##-----------------------------------------------------------------------------
## Uso de expressões regulares.
## Quantificadores de ocorrência.
## ?: 0 ou 1;
## *: >=0;
## +: >0;
## {m}; m;
## {m,n}; >=m e <=n;
## {m,}; >=m;
x <- c("aabbcc","abc","aabcd","bbbc","aacc")
grep(x=x, pattern="ab?c", value=TRUE)
grep(x=x, pattern="ab*c", value=TRUE)
grep(x=x, pattern="ab+c", value=TRUE)
grep(x=x, pattern="ab{2}c", value=TRUE)
## Representantes.
## [123], os elementos 1, 2 ou 3;
## [1-3], os elementos 1, 2 ou 3;
## [0-9], as unidades;
## [a-f], de a até f;
## [a-z], de a até z;
## [A-Z], de A até Z;
## [^02468], exceto os pares;
## [^aeiou], exceto as vogais;
## [^walmes], exceto as letras que formam meu nome;
## \d, igual a [0-9];
## \D, igual a [^0-9];
## \w, igual a [0-9A-z];
## \W, igual a [^0-9A-z];
## ., qualquer coisa.
x <- c("abBBc", "a10c", "a100bc", "a8Bc", "aAABc","aacc")
grep(x=x, pattern="a...c", value=TRUE)
grep(x=x, pattern="a.+c", value=TRUE)
grep(x=x, pattern="a.{2}c", value=TRUE)
grep(x=x, pattern="a[bB]{3}c", value=TRUE)
grep(x=x, pattern="a[0-9]", value=TRUE)
grep(x=x, pattern="a[^0-9]", value=TRUE)
grep(x=x, pattern="a[0-9]+", value=TRUE)
grep(x=x, pattern="a[0-9]{2}", value=TRUE)
grep(x=x, pattern="a\\d{2}", value=TRUE)
grep(x=x, pattern="a\\d{2,}.?c", value=TRUE)
## Âncoras.
## ^: início da string;
## $: final da string;
## \b: borda de palavra;
x <- c("Andre Marques", "Luciana Martins", "Carlos Ribeiro",
"Alcidez Bernal", "Cristina Poeta")
grep(x=x, pattern="^A", value=TRUE)
grep(x=x, pattern="s$", value=TRUE)
grep(x=x, pattern="\\bM", value=TRUE)
grep(x=x, pattern="a\\b", value=TRUE)
## Combinando esses poderes as possibilidades são inúmeras.
##-----------------------------------------------------------------------------
## Extraindo pedaços das informações dos donos e veículos.
str(dn)
x <- dn$espec
sx <- head(sample(x), 10); sx
## Retirar modelo. Primeiro o teste depois definitivo.
gsub(pattern="^.*/([0-9]{4})$", replacement="\\1", x=sx)
dn$modelo <- gsub(pattern="^.*/([0-9]{4})$", replacement="\\1", x=x)
## Retirar ano. Primeiro o teste depois definitivo.
gsub(pattern="^.*([0-9]{4})/[0-9]{4}$", replacement="\\1", x=sx)
dn$ano <- gsub(pattern="^.*([0-9]{4})/[0-9]{4}$", replacement="\\1", x=x)
xtabs(~modelo+carro, dn)
xtabs(~ano+carro, dn)
## Retirar potência.
gsub(pattern="^.*(\\d\\.\\d).*[0-9]{4}/[0-9]{4}$",
replacement="\\1", x=sx)
dn$pot <- gsub(pattern="^.*(\\d\\.\\d).*[0-9]{4}/[0-9]{4}$",
replacement="\\1", x=x)
xtabs(~pot+carro, data=dn)
## Como se trata de apenas dois níveis, isso aqui, nesse caso, é
## equivalente.
dn$pot <- 1.6
dn$pot[grepl("1\\.0", x)] <- 1.0
## Nem todos os carros têm os km rodados. O que fazer?
x <- dn$hist
sx <- head(sample(x), 10); sx
## Retirar km rodados.
gsub(pattern="^.*- (.*) km.*$", replacement="\\1", x=sx)
dn$kmrod <- gsub(pattern="^.*- (.*) km.*$",
replacement="\\1", x=x)
dn$kmrod <- as.numeric(dn$kmrod)
## Warning: NAs introduced by coercion
## Retirar ano com o veículo.
gsub(pattern="^.*(\\d) ano.*$", replacement="\\1", x=sx)
dn$donoha <- gsub(pattern="^.*(\\d) ano.*$",
replacement="\\1", x=x)
dn$donoha <- as.integer(dn$donoha)
densityplot(~kmrod|carro, data=dn)
densityplot(~log10(kmrod)|carro, data=dn)
ecdfplot(~log10(kmrod), groups=carro, data=dn, auto.key=TRUE)
xtabs(~ano+carro, data=dn)
with(dn, tapply(kmrod, carro, summary))
##-----------------------------------------------------------------------------
## Como juntar os dados de uma tabela com os de outra?
bd1 <- data.frame(id=1:5, nota=runif(5))
bd2 <- data.frame(id=3:9, aptdao=runif(7))
merge(bd1, bd2, by="id")
merge(bd1, bd2, by="id", all.x=TRUE)
merge(bd1, bd2, by="id", all.y=TRUE)
merge(bd1, bd2, by="id", all=TRUE)
names(ntw)
names(dn)
mrg <- merge(ntw, dn, by=c("carro","dono"), all=TRUE)
names(mrg)
ag <- aggregate(cbind(Consumo, Recomendação, Motor)~carro+ano, data=mrg, FUN=mean)
str(ag)
xyplot(Consumo~as.numeric(ano), groups=carro, data=ag,
type="b")
xyplot(Consumo+Recomendação+Motor~as.numeric(ano), groups=carro, data=ag,
type="b", outer=TRUE)
