##============================================================================= ## Estatística Computacional I www.leg.ufpr.br/ce083 ## Curso de Estatística - 2014/2 ## Prof. Walmes Zeviani ## LEG - DEST - UFPR ## ## Aula 13 (23/09/2014) ##============================================================================= ##----------------------------------------------------------------------------- ## Definções do knitr. Não rodar. opts_chunk$set( cache=FALSE, tidy=FALSE, fig.width=7, fig.height=6, fig.align="center", dpi=150, dev="png", dev.args=list(png=list(family="Ubuntu Light", type="cairo"))) opts_chunk$set(fig.path="fig/aula13") options(width=90) section <- function(name){ abb <- abbreviate(iconv(name, to="ASCII//TRANSLIT")) l1 <- sprintf(" %s", abb, name) l2 <- sprintf("[%s](#%s)", name, abb) return(c("title"=l1, "anchor"=l2)) } L <- list(section("Medidas descritivas"), section("Medidas descritivas por estrato")) ##----------------------------------------------------------------------------- ## Medidas descritivas. ## Posição: média, mediana, moda. ## Separação: extremos, quartis, quantis. ## Dispersão: amplitude, variância/desvio-padrão, desvio absoluto da ## mediana, amplitude interquartílica, coeficiente de variação. ## Forma: coeficiente de assimetria e coeficiente de curtose. ##----------------------------------------------------------------------------- ## Pacotes com funções úteis para obter medidas descritivas. require(plyr) ## ddply(), colwise(), each(). require(reshape) ## melt(), cast(). require(doBy) ## summaryBy(). ##----------------------------------------------------------------------------- ## Lendo dados de veículos Renault Duster à venda no ## `http://www.webmotors.com.br/` 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, vec.len=1) ##----------------------------------------------------------------------------- ## Quantos NA tem em cada coluna? sumNA <- function(x) sum(is.na(x)) colwise(.fun=sumNA)(dus) ## Pode se usar apply também. apply(dus, MARGIN=2, sumNA) ## Se fizer na.omit() será jogado fora veículos com informações para as ## demais variáveis. ## dus <- na.omit(dus) ## str(dus) ##----------------------------------------------------------------------------- ## Questões. ## Qual o total de veículos? nrow(dus) ## Quantos custam mais que 50 mil? sum(dus$valor>50000) ## Qual a proporção que custa mais que 50 mil? sum(dus$valor>50000)/nrow(dus) prop.table(table(dus$valor>50000)) ## Qual o custo médio dos carros da amostra? mean(dus$valor) ## Qual o custo mediano dos carros da amostra? median(dus$valor) ## Qual o desvio-padrão do custo dos carros da amostra? sd(dus$valor) sqrt(var(dus$valor)) ## Qual a amplitude do custo dos carros da amostra? with(dus, max(valor)-min(valor)) diff(range(dus$valor)) ## Quartis? fivenum(dus$valor) ## Cinco números de Tukey: extremos e quartis. quantile(dus$valor, prob=0.65) ## Qualquer percentil. quantile(dus$valor, prob=(1:3)/4) ## 1Q = 25%, 2Q=50% e 3Q=75%. ## Desvio médio absoluto da mediana. dmam <- function(x){ sum(abs(median(x)-x))/length(x) } ## Desvio mediano absoluto da mediana. dmdam <- function(x){ median(abs(median(x)-x)) } ## help(mad, help_type="html") dmam(dus$valor) dmdam(dus$valor) mad(dus$valor, constant=1) ## Coeficiente de variação? ## cv <- function(x, ...){ ## 100*sd(x, ...)/mean(x, ...) ## } cv <- function(x, na.rm=FALSE, ...){ 100*sd(x, na.rm=na.rm)/mean(x, na.rm=na.rm, ...) } cv(dus$valor, na.rm=TRUE) cv(dus$valor, na.rm=TRUE, trim=0.1) ## Como obter todas as medidas descritivas de uma vez? ## Função que retorna mais de uma estatística. mystats <- function(x){ f <- fivenum(x) c(media=mean(x), mediana=f[3], "desv pad"=sd(x), ampli=f[5]-f[1], cv=cv(x), "1Q"=f[2], "3Q"=f[4]) } sts <- mystats(dus$valor) ## sts cbind(sts) ##----------------------------------------------------------------------------- ## Perguntas. ## Qual a frequência para cada tipo de tração? table(dus$trac) xtabs(~trac, data=dus) ## Qual a frequência para cada tipo de cambio? xtabs(~cambio, data=dus) ## Qual a frequência para cada tipo de cambio x tipo de tração? xtabs(~trac+cambio, data=dus) ## Qual o preço médio para cada tipo de tração? with(dus, tapply(valor, trac, mean)) aggregate(valor~trac, data=dus, FUN=mean) with(dus, by(valor, trac, FUN=mean)) ## Qual o preço médio e o desvio padrão para cada tipo de tração? myfun <- function(x) c(m=mean(x), s=sd(x)) with(dus, tapply(valor, trac, myfun)) aggregate(valor~trac, data=dus, FUN=myfun) with(dus, by(valor, trac, FUN=myfun)) aggregate(valor~trac, data=dus, FUN=each(mean, sd)) ## Qual o preço médio para cada tipo de tração x tipo de cambio? with(dus, tapply(valor, list(trac, cambio), mean)) aggregate(valor~trac+cambio, data=dus, FUN=myfun) with(dus, by(valor, list(trac, cambio), FUN=myfun)) ##----------------------------------------------------------------------------- ## Extraindo o código R do arquivo *.Rmd. Não rodar. system("kpurl --noheader ce083-2014-02-aula13.Rmd") ##-----------------------------------------------------------------------------