Carregamento de Bibliotecas
library(knitr)
library(readr)
library(readxl)
library(xtable)
library(kableExtra)
library(tibble)
library(lubridate)
library(tidyverse)
library(DescTools)
library(sjlabelled)
# Ajuste de limites para se usar a notação científica
options(scipen = 9999)
# Setando valores de Fusos horários
Sys.setenv(TZ="Brazil/East")
options(tz="Brazil/East")
Sys.getenv("TZ")
## [1] "Brazil/East"
Sys.setlocale("LC_TIME", "pt_BR")
## [1] "pt_BR"
Carregamento de Funções Auxiliares
# Funçoes Auxiliares
source("~/Dropbox/Coding/R/funs/msrfun.R")
Carregamento do Banco
# Carregamento do arquivo
p56 <- read_delim("~/Dropbox/AaZ/M/Mestrado/Aulas/2019-01/EPI84 - Introdução à informática aplicada à pesquisa epidemiológica/r_p56/data/p56_int_2017.csv",
";", escape_double = FALSE, col_names = FALSE,
trim_ws = TRUE)
# Atribuo o banco a variavel de trabalho df.
df <- p56
Criação dos Rótulos das Variáveis
# Trocando o nome das varíáveis
names(df) <- c("questionario", "data", "idade", "peso", "altura", "serie", "grau", "fumo", "cor", "sexo", "aco",
"sist", "diast", "p56" )
# Criação dos rótulos das variáveis
rotulos <- c("Número do questionário", "Data da Medida", "Idade - Anos completos", "Peso em kg", "Altura em metros",
"Escolaridade - Série", "Escolaridade - Grau", "Fumo de cigarros", "Cor da pele",
"Uso de anticoncepcional oral", "Pressão arterial sistólica", "Pressão arterial diastólica",
"Peptídeo 56")
# Atribui os rotúlos as variáveis
df <- set_label(df,label = rotulos)
Análise Exploratória das variáveis
# Testa se existem variáveis duplicadas
df$questionario[duplicated(df$questionario)]
## numeric(0)
# Testa os limites da idade
Desc(df$idade)
## -------------------------------------------------------------------------
## df$idade (numeric)
##
## length n NAs unique 0s mean meanCI
## 755 755 0 51 0 35.95 35.05
## 100.0% 0.0% 0.0% 36.85
##
## .05 .10 .25 median .75 .90 .95
## 18.00 21.00 27.00 34.00 43.00 55.60 60.00
##
## range sd vcoef mad IQR skew kurt
## 50.00 12.62 0.35 11.86 16.00 0.51 -0.59
##
## lowest : 15.0 (4), 16.0 (13), 17.0 (19), 18.0 (22), 19.0 (6)
## highest: 61.0 (10), 62.0 (6), 63.0 (7), 64.0 (10), 65.0 (3)
# Peso
summary(df$peso)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 35.00 56.00 63.00 78.98 73.00 888.00
plot(df$peso)
hist(df$peso)
# Detectado pesos com valor 888
# OU atribuir NA ao valor 888 OU filtrar o caso inteiro OU criar variável auxiliar "inclusão"
df$inclusao <- ifelse(df$peso == 888, 0, 1) # Remover os pesos com valor 888
table(df$inclusao)
##
## 0 1
## 13 742
# p56
Desc(df$p56)
## -------------------------------------------------------------------------
## df$p56 (numeric)
##
## length n NAs unique 0s mean meanCI
## 755 755 0 284 0 236.58 227.36
## 100.0% 0.0% 0.0% 245.80
##
## .05 .10 .25 median .75 .90 .95
## 129.70 142.40 163.00 196.00 256.00 370.60 506.30
##
## range sd vcoef mad IQR skew kurt
## 882.00 129.01 0.55 60.79 93.00 2.62 8.08
##
## lowest : 103.0, 105.0, 106.0 (2), 108.0, 109.0
## highest: 817.0, 851.0, 908.0, 939.0, 985.0
# Criação de labels e variáveis categoricas
df$cor <- factor(df$cor, labels = c("Branco", "Mulato", "Negro", NA))
df$sexo <- factor(df$sexo, labels = c("Masculino", "Feminino"))
df$grau <- factor(df$grau, labels = c("Fundamental", "Médio", "Superior"))
df$fumo <- factor(df$fumo, labels = c("Sim", "Não"))
variaveis <- c("df$cor", "df$sexo", "df$grau")
Desc(df$cor)
## -------------------------------------------------------------------------
## df$cor (factor)
##
## length n NAs unique levels dupes
## 755 755 0 4 4 y
## 100.0% 0.0%
##
## level freq perc cumfreq cumperc
## 1 Branco 621 82.3% 621 82.3%
## 2 Negro 88 11.7% 709 93.9%
## 3 Mulato 45 6.0% 754 99.9%
## 4 <NA> 1 0.1% 755 100.0%
Desc(df$sexo)
## -------------------------------------------------------------------------
## df$sexo (factor - dichotomous)
##
## length n NAs unique
## 755 755 0 2
## 100.0% 0.0%
##
## freq perc lci.95 uci.95'
## Masculino 298 39.5% 36.0% 43.0%
## Feminino 457 60.5% 57.0% 64.0%
##
## ' 95%-CI Wilson
Desc(df$grau)
## -------------------------------------------------------------------------
## df$grau (factor)
##
## length n NAs unique levels dupes
## 755 755 0 3 3 y
## 100.0% 0.0%
##
## level freq perc cumfreq cumperc
## 1 Fundamental 398 52.7% 398 52.7%
## 2 Superior 208 27.5% 606 80.3%
## 3 Médio 149 19.7% 755 100.0%
Desc(df$fumo)
## -------------------------------------------------------------------------
## df$fumo (factor - dichotomous)
##
## length n NAs unique
## 755 755 0 2
## 100.0% 0.0%
##
## freq perc lci.95 uci.95'
## Sim 272 36.0% 32.7% 39.5%
## Não 483 64.0% 60.5% 67.3%
##
## ' 95%-CI Wilson
# Criação de variáveis de data
df$data <- mdy(df$data)
Desc(df$data)
## -------------------------------------------------------------------------
## df$data (Date)
##
## length n NAs unique
## 755 755 0 288
## 100.0% 0.0%
##
## lowest : 2002-01-01 (3), 2002-01-02 (2), 2002-01-03, 2002-01-04
## highest: 2002-11-24, 2002-11-26 (5), 2002-11-28 (5), 2002-11-29 (3)
##
##
## Weekday:
##
## Pearson's Chi-squared test (1-dim uniform):
## X-squared = 3.5311, df = 6, p-value = 0.7398
##
## level freq perc cumfreq cumperc
## 1 Monday 108 14.3% 108 14.3%
## 2 Tuesday 114 15.1% 222 29.4%
## 3 Wednesday 114 15.1% 336 44.5%
## 4 Thursday 96 12.7% 432 57.2%
## 5 Friday 118 15.6% 550 72.8%
## 6 Saturday 101 13.4% 651 86.2%
## 7 Sunday 104 13.8% 755 100.0%
##
## Months:
##
## Pearson's Chi-squared test (1-dim uniform):
## X-squared = 81.042, df = 11, p-value = 0.0000000000009274
##
## level freq perc cumfreq cumperc
## 1 January 58 7.7% 58 7.7%
## 2 February 69 9.1% 127 16.8%
## 3 March 74 9.8% 201 26.6%
## 4 April 78 10.3% 279 37.0%
## 5 May 63 8.3% 342 45.3%
## 6 June 68 9.0% 410 54.3%
## 7 July 76 10.1% 486 64.4%
## 8 August 61 8.1% 547 72.5%
## 9 September 53 7.0% 600 79.5%
## 10 October 79 10.5% 679 89.9%
## 11 November 76 10.1% 755 100.0%
## 12 December 0 0.0% 755 100.0%
##
## By weeks :
##
## level freq perc cumfreq cumperc
## 1 2001-12-31 12 1.6% 12 1.6%
## 2 2002-01-07 15 2.0% 27 3.6%
## 3 2002-01-14 8 1.1% 35 4.6%
## 4 2002-01-21 19 2.5% 54 7.2%
## 5 2002-01-28 15 2.0% 69 9.1%
## 6 2002-02-04 19 2.5% 88 11.7%
## 7 2002-02-11 16 2.1% 104 13.8%
## 8 2002-02-18 15 2.0% 119 15.8%
## 9 2002-02-25 13 1.7% 132 17.5%
## 10 2002-03-04 21 2.8% 153 20.3%
## 11 2002-03-11 24 3.2% 177 23.4%
## 12 2002-03-18 14 1.9% 191 25.3%
## 13 2002-03-25 10 1.3% 201 26.6%
## 14 2002-04-01 17 2.3% 218 28.9%
## 15 2002-04-08 16 2.1% 234 31.0%
## 16 2002-04-15 18 2.4% 252 33.4%
## 17 2002-04-22 22 2.9% 274 36.3%
## 18 2002-04-29 17 2.3% 291 38.5%
## 19 2002-05-06 13 1.7% 304 40.3%
## 20 2002-05-13 12 1.6% 316 41.9%
## 21 2002-05-20 17 2.3% 333 44.1%
## 22 2002-05-27 14 1.9% 347 46.0%
## 23 2002-06-03 16 2.1% 363 48.1%
## 24 2002-06-10 19 2.5% 382 50.6%
## 25 2002-06-17 14 1.9% 396 52.5%
## 26 2002-06-24 14 1.9% 410 54.3%
## 27 2002-07-01 15 2.0% 425 56.3%
## 28 2002-07-08 22 2.9% 447 59.2%
## 29 2002-07-15 15 2.0% 462 61.2%
## 30 2002-07-22 22 2.9% 484 64.1%
## 31 2002-07-29 5 0.7% 489 64.8%
## 32 2002-08-05 14 1.9% 503 66.6%
## 33 2002-08-12 22 2.9% 525 69.5%
## 34 2002-08-19 10 1.3% 535 70.9%
## 35 2002-08-26 13 1.7% 548 72.6%
## 36 2002-09-02 15 2.0% 563 74.6%
## 37 2002-09-09 14 1.9% 577 76.4%
## 38 2002-09-16 13 1.7% 590 78.1%
## 39 2002-09-23 10 1.3% 600 79.5%
## 40 2002-09-30 14 1.9% 614 81.3%
## 41 2002-10-07 21 2.8% 635 84.1%
## 42 2002-10-14 13 1.7% 648 85.8%
## 43 2002-10-21 23 3.0% 671 88.9%
## 44 2002-10-28 19 2.5% 690 91.4%
## 45 2002-11-04 16 2.1% 706 93.5%
## 46 2002-11-11 19 2.5% 725 96.0%
## 47 2002-11-18 17 2.3% 742 98.3%
## 48 2002-11-25 13 1.7% 755 100.0%
Criação das Variáveis Derivadas
# Percentil 75 da variável
# Usei a função quantile para determinar o percentil 75%
# Precisa a opção include.lowest = TRUE para incluir o valor menor da distribuição - senão coloca NA nessa posição
df$p56_perc75 <- cut(x = df$p56,breaks = quantile(df$p56,probs = c(0,.75,1)),include.lowest = TRUE)
Desc(df$p56_perc75)
## -------------------------------------------------------------------------
## df$p56_perc75 (factor - dichotomous)
##
## length n NAs unique
## 755 755 0 2
## 100.0% 0.0%
##
## freq perc lci.95 uci.95'
## [103,256] 568 75.2% 72.0% 78.2%
## (256,985] 187 24.8% 21.8% 28.0%
##
## ' 95%-CI Wilson
# Criação da variável Hipertensão
# Ponto de corte: >= 140
df$hiper <- if_else(df$sist >= 140 | df$diast >= 90, 1, 0)
df$hiper <- factor(df$hiper, labels = c("Hipertenso", "Não Hipertenso"))
table(df$hiper)
##
## Hipertenso Não Hipertenso
## 572 183
Análises Descritivas e Comparativas
# Análise Descritiva para variável p56
Desc(df$p56)
## -------------------------------------------------------------------------
## df$p56 (numeric)
##
## length n NAs unique 0s mean meanCI
## 755 755 0 284 0 236.58 227.36
## 100.0% 0.0% 0.0% 245.80
##
## .05 .10 .25 median .75 .90 .95
## 129.70 142.40 163.00 196.00 256.00 370.60 506.30
##
## range sd vcoef mad IQR skew kurt
## 882.00 129.01 0.55 60.79 93.00 2.62 8.08
##
## lowest : 103.0, 105.0, 106.0 (2), 108.0, 109.0
## highest: 817.0, 851.0, 908.0, 939.0, 985.0
# Comparação das médias da variável P56 para cada uma das categorias da variável HIPER
df %>%
group_by(hiper) %>%
summarise(Média_p56 = mean(p56))
## # A tibble: 2 x 2
## hiper Média_p56
## <fct> <dbl>
## 1 Hipertenso 220.
## 2 Não Hipertenso 289.
table(df$p56_perc75, df$hiper)
##
## Hipertenso Não Hipertenso
## [103,256] 456 112
## (256,985] 116 71
prop.table(table(df$p56_perc75, df$hiper))
##
## Hipertenso Não Hipertenso
## [103,256] 0.60397351 0.14834437
## (256,985] 0.15364238 0.09403974
fisher.test(df$p56_perc75, df$hiper)
##
## Fisher's Exact Test for Count Data
##
## data: df$p56_perc75 and df$hiper
## p-value = 0.00000113
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
## 1.705682 3.624581
## sample estimates:
## odds ratio
## 2.488541