Questões

VADeaths

Import dos dados

VADeaths <- as.data.frame.table(VADeaths)

Estrutura

str(VADeaths)
## 'data.frame':    20 obs. of  3 variables:
##  $ Var1: Factor w/ 5 levels "50-54","55-59",..: 1 2 3 4 5 1 2 3 4 5 ...
##  $ Var2: Factor w/ 4 levels "Rural Male","Rural Female",..: 1 1 1 1 1 2 2 2 2 2 ...
##  $ Freq: num  11.7 18.1 26.9 41 66 8.7 11.7 20.3 30.9 54.3 ...

Gráfico

tab <- xtabs(Freq ~ Var2 + Var1, data = VADeaths)

cores <- c("plum", "darkorchid", "hotpink", "mediumvioletred")

barplot(
  tab,
  beside = TRUE,
  col = cores,
  legend = TRUE,
  args.legend = list(title = "Categorias", x = "topleft"),
  main = "Categorias em barras",
  xlab = "Var1 - Faixa etária",
  ylab = "Frequência"
)

ClassificaçãoDoença

Monta os resultados dos pacientes

vinte_pacientes <- c(
  "moderado","leve","leve","severo","leve",
  "moderado","moderado","moderado","leve","leve",
  "severo","leve","moderado","moderado","leve",
  "severo","moderado","moderado","moderado","leve"
)

Tabela de doenças

tab <- table(vinte_pacientes)

Porcentagens

pct <- round(tab / sum(tab) * 100, 1)

Gráfico

labels <- paste0(names(tab), " - ", pct, "%")

cores <- c("plum", "orchid", "hotpink")

pie(
  tab,
  labels = labels,
  col = cores,
  main = "Distribuição dos Estágios da Doença"
)

legend(
  "topright",
  legend = names(tab),
  fill = cores,
  title = "Estágio"
)

Teorema

Carregar os dados

flu <- read.csv("flu.csv")

Visualização

str(flu)
## 'data.frame':    75034 obs. of  1 variable:
##  $ age: int  0 0 0 0 0 0 0 0 0 0 ...

Histograma antes do TLC

hist(
  flu$age,
  breaks = 40,
  freq = FALSE,
  col = "hotpink",
  main = "Histograma da População (Idades)\nAntes do Teorema do Limite Central",
  xlab = "Idade"
)

lines(density(flu$age), col = "purple", lwd = 2)

Criar 200 médias de tamanho 35

set.seed(123)

medias <- replicate(
  200,
  mean(sample(flu$age, size = 35, replace = TRUE))
)

Histograma das médias (TLC)

hist(
  medias,
  breaks = 20,
  freq = FALSE,
  col = "plum",
  main = "Distribuição das Médias Amostrais (n = 35)\nTeorema do Limite Central",
  xlab = "Média das amostras"
)

lines(density(medias), col = "darkmagenta", lwd = 2)

Comparação dos gŕaficos

par(mfrow = c(1, 2)) # 2 gráficos lado a lado

hist(
  flu$age,
  breaks = 40,
  freq = FALSE,
  col = "lightpink",
  main = "Antes do TLC",
  xlab = "Idade"
)
lines(density(flu$age), col = "purple", lwd = 2)

hist(
  medias,
  breaks = 20,
  freq = FALSE,
  col = "plum",
  main = "Após TCL ",
  xlab = "Média da idade"
)
lines(density(medias), col = "darkmagenta", lwd = 2)

par(mfrow = c(1, 1))

Gatos da Ruralinda

Eu sei que essa questão não é para ser aqui, mas eu resolvi fazer apenas para aproveitar o documento.

Parâmetros da questão

sigma <- 0.5  # desvio-padrão
E <- 0.1      # erro amostral
Z <- 2.576    # valor crítico para 99%
N <- 300      # população

Tamanho da amostra

n0 <- (Z * sigma / E)^2

Tamanho da amostra

n0 <- (Z * sigma / E)^2

População finita

n <- n0 / (1 + (n0 - 1) / N)
n_round <- round(n, 2)

Resultado final

n_round
## [1] 107.05

RU da Ruralinda

Parâmetros da questão

media <- 400      # média em gramas
dp <- 45          # desvio-padrão
valor <- 500      # ponto de corte

Proporção acima de 500 gramas

prop <- pnorm(valor, mean = media, sd = dp, lower.tail = FALSE)

Resultado final em porcentagem

prop_perc <- sprintf("%.2f%%", prop * 100)
prop_perc
## [1] "1.31%"

Bdmis

Carregar os dados

load("bdims.RData")

Visualização dos dados

str(bdims)
## 'data.frame':    507 obs. of  25 variables:
##  $ bia.di: num  42.9 43.7 40.1 44.3 42.5 43.3 43.5 44.4 43.5 42 ...
##  $ bii.di: num  26 28.5 28.2 29.9 29.9 27 30 29.8 26.5 28 ...
##  $ bit.di: num  31.5 33.5 33.3 34 34 31.5 34 33.2 32.1 34 ...
##  $ che.de: num  17.7 16.9 20.9 18.4 21.5 19.6 21.9 21.8 15.5 22.5 ...
##  $ che.di: num  28 30.8 31.7 28.2 29.4 31.3 31.7 28.8 27.5 28 ...
##  $ elb.di: num  13.1 14 13.9 13.9 15.2 14 16.1 15.1 14.1 15.6 ...
##  $ wri.di: num  10.4 11.8 10.9 11.2 11.6 11.5 12.5 11.9 11.2 12 ...
##  $ kne.di: num  18.8 20.6 19.7 20.9 20.7 18.8 20.8 21 18.9 21.1 ...
##  $ ank.di: num  14.1 15.1 14.1 15 14.9 13.9 15.6 14.6 13.2 15 ...
##  $ sho.gi: num  106 110 115 104 108 ...
##  $ che.gi: num  89.5 97 97.5 97 97.5 ...
##  $ wai.gi: num  71.5 79 83.2 77.8 80 82.5 82 76.8 68.5 77.5 ...
##  $ nav.gi: num  74.5 86.5 82.9 78.8 82.5 80.1 84 80.5 69 81.5 ...
##  $ hip.gi: num  93.5 94.8 95 94 98.5 95.3 101 98 89.5 99.8 ...
##  $ thi.gi: num  51.5 51.5 57.3 53 55.4 57.5 60.9 56 50 59.8 ...
##  $ bic.gi: num  32.5 34.4 33.4 31 32 33 42.4 34.1 33 36.5 ...
##  $ for.gi: num  26 28 28.8 26.2 28.4 28 32.3 28 26 29.2 ...
##  $ kne.gi: num  34.5 36.5 37 37 37.7 36.6 40.1 39.2 35.5 38.3 ...
##  $ cal.gi: num  36.5 37.5 37.3 34.8 38.6 36.1 40.3 36.7 35 38.6 ...
##  $ ank.gi: num  23.5 24.5 21.9 23 24.4 23.5 23.6 22.5 22 22.2 ...
##  $ wri.gi: num  16.5 17 16.9 16.6 18 16.9 18.8 18 16.5 16.9 ...
##  $ age   : int  21 23 28 23 22 21 26 27 23 21 ...
##  $ wgt   : num  65.6 71.8 80.7 72.6 78.8 74.8 86.4 78.4 62 81.6 ...
##  $ hgt   : num  174 175 194 186 187 ...
##  $ sex   : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...

Filtrar apenas mulheres

mulheres <- subset(bdims, sex == "0")

Parâmetros

h <- mulheres$hgt

n <- length(h)
media <- mean(h)
dp <- sd(h)
conf <- 0.985
alpha <- 1 - conf

T-Critico

tcrit <- qt(1 - alpha/2, df = n - 1)

Erro padrão

EP <- dp / sqrt(n)

Intervalo de confiança

IC_inf <- media - tcrit * EP
IC_sup <- media + tcrit * EP

round(c(IC_inf, IC_sup), 2)
## [1] 163.88 165.87