Trabalho Semanal 2

Autor

Tiago Teodoro Vaz de Resende - 24.2.4056

#Pacotes necessarios
library(pacman)

Warning: pacote 'pacman' foi compilado no R versão 4.6.1

pacman::p_load(tidyverse, data.table, tidyverse)
#Leitura dos dados
arq <- "C:/Users/tiago/OneDrive/Ambiente de Trabalho/Analise longitudinal/porquinho_India.csv"

dados <- read.table(arq,sep=";", dec = ",", fileEncoding = "latin1",
     header=T, colClasses = c("numeric","numeric", "numeric","numeric","numeric"))
dados <- as.data.table(dados)
#dados <- dados[, 2:8] #remove a primeira coluna "id"
#head(dados)  #formato largo
dados <- within(dados,ID <- factor(ID))

1. Gráfico Espaguete para cada Grupo

#converter para o formato longo
  dados_longo <- reshape(data= dados, direction = "long",
                       idvar = "ID", varying = list(names(dados)[3:8]),
                      v.names = "Peso", time = c(1, 3, 4, 5, 6, 7),
                     timevar="Semana")

#torna ID uma variável do tipo factor e classifica as semanas em "1","2", "3"
dados_longo <- within(dados_longo, {  ID <- factor(ID)
Grupo <- factor(Grupo,levels=1:3,labels=c("1","2", "3"))
})
#Gráfico espaquete

ggplot(dados_longo, aes(x = Semana, y = Peso, group = ID, color = Grupo ))+
  geom_line()+
  geom_point(shape=18) + 
  stat_summary(aes(group = 1),geom = "line", fun = mean, linewidth = 1.5) +
  facet_grid(. ~ Grupo)+
  theme_minimal()+
  theme(legend.position = "none")+
  scale_colour_manual(
    values = c(
    "1" = "cyan",
    "2" = "mediumpurple",
    "3" =  "mediumspringgreen" 
  ),
  name = "Grupo"
  )+
  labs(
    title = "Gráficos de espaguete por grupo",
    x = "Semanas",
    y = "Peso"
  )

2. Matrizes de Covariância Entre as 6 Semanas

2.1 Obter as matrizes de covariância e de correlações entre as 6 semanas:

Matriz de covariâncias Amostrais:

\[ \hat{V_i} = (m-1)^{-1} \sum_{i=1}^m (Y_i - \bar{Y})(Y_i-\bar{Y})^{'} \tag{1}\]

Como a base já está, originalmente, em formato largo:

Separando os três grupos de porquinhos da india (1, 2 e 3):

grupo1 <- dados |>
  filter(Grupo == 1)
grupo2 <- dados |>
  filter(Grupo == 2)
grupo3 <- dados |>
  filter(Grupo == 3)
head(grupo1); head(grupo2); head(grupo3)

       ID Grupo  Sem1  Sem3  Sem4  Sem5  Sem6  Sem7
   <fctr> <num> <num> <num> <num> <num> <num> <num>
1:      1     1   455   460   510   504   436   466
2:      2     1   467   565   610   596   542   587
3:      3     1   445   530   580   597   582   619
4:      4     1   485   542   594   583   611   612
5:      5     1   480   500   550   528   562   576

       ID Grupo  Sem1  Sem3  Sem4  Sem5  Sem6  Sem7
   <fctr> <num> <num> <num> <num> <num> <num> <num>
1:      6     2   514   560   565   524   552   597
2:      7     2   440   480   536   484   567   569
3:      8     2   495   570   569   585   576   677
4:      9     2   520   590   610   637   671   702
5:     10     2   503   555   591   605   649   675

       ID Grupo  Sem1  Sem3  Sem4  Sem5  Sem6  Sem7
   <fctr> <num> <num> <num> <num> <num> <num> <num>
1:     11     3   496   560   622   622   632   670
2:     12     3   498   540   589   557   568   609
3:     13     3   478   510   568   555   576   605
4:     14     3   545   565   580   601   633   649
5:     15     3   472   498   540   524   532   583

Covariância e Correlação para o grupo 1:

(cov1 <- round(cov(grupo1[,3:8]), 2))

       Sem1    Sem3   Sem4    Sem5    Sem6    Sem7
Sem1 279.80  158.55  167.1  -34.80  476.95  252.50
Sem3 158.55 1651.80 1606.1 1625.20 1972.95 2076.25
Sem4 167.10 1606.10 1567.2 1592.90 2010.90 2077.50
Sem5 -34.80 1625.20 1592.9 1835.30 2081.55 2251.75
Sem6 476.95 1972.95 2010.9 2081.55 4472.80 3989.00
Sem7 252.50 2076.25 2077.5 2251.75 3989.00 3821.50

(cor1 <- round(cor(grupo1[,3:8]), 2))

      Sem1 Sem3 Sem4  Sem5 Sem6 Sem7
Sem1  1.00 0.23 0.25 -0.05 0.43 0.24
Sem3  0.23 1.00 1.00  0.93 0.73 0.83
Sem4  0.25 1.00 1.00  0.94 0.76 0.85
Sem5 -0.05 0.93 0.94  1.00 0.73 0.85
Sem6  0.43 0.73 0.76  0.73 1.00 0.96
Sem7  0.24 0.83 0.85  0.85 0.96 1.00

Grupo 2:

(cov2 <- round(cov(grupo2[,3:8]), 2))

        Sem1    Sem3    Sem4    Sem5    Sem6    Sem7
Sem1 1018.30 1270.75  738.90 1450.50  769.75 1232.50
Sem3 1270.75 1755.00  998.50 2182.50 1105.00 1978.75
Sem4  738.90  998.50  783.70 1654.25 1298.00 1430.75
Sem5 1450.50 2182.50 1654.25 3851.50 2800.75 3519.50
Sem6  769.75 1105.00 1298.00 2800.75 2841.50 2394.00
Sem7 1232.50 1978.75 1430.75 3519.50 2394.00 3312.00

(cor2 <- round(cor(grupo2[,3:8]), 2))

     Sem1 Sem3 Sem4 Sem5 Sem6 Sem7
Sem1 1.00 0.95 0.83 0.73 0.45 0.67
Sem3 0.95 1.00 0.85 0.84 0.49 0.82
Sem4 0.83 0.85 1.00 0.95 0.87 0.89
Sem5 0.73 0.84 0.95 1.00 0.85 0.99
Sem6 0.45 0.49 0.87 0.85 1.00 0.78
Sem7 0.67 0.82 0.89 0.99 0.78 1.00

Grupo 3:

(cov3 <- round(cov(grupo3[,3:8]), 2))

       Sem1    Sem3    Sem4    Sem5    Sem6    Sem7
Sem1 822.20  705.40  298.95  712.70  930.80  632.05
Sem3 705.40  885.80  718.65 1061.40 1180.60  953.85
Sem4 298.95  718.65  897.20 1022.20 1013.05  916.05
Sem5 712.70 1061.40 1022.20 1539.70 1674.30 1385.05
Sem6 930.80 1180.60 1013.05 1674.30 1910.20 1493.45
Sem7 632.05  953.85  916.05 1385.05 1493.45 1251.20

(cor3 <- round(cor(grupo3[,3:8]), 2))

     Sem1 Sem3 Sem4 Sem5 Sem6 Sem7
Sem1 1.00 0.83 0.35 0.63 0.74 0.62
Sem3 0.83 1.00 0.81 0.91 0.91 0.91
Sem4 0.35 0.81 1.00 0.87 0.77 0.86
Sem5 0.63 0.91 0.87 1.00 0.98 1.00
Sem6 0.74 0.91 0.77 0.98 1.00 0.97
Sem7 0.62 0.91 0.86 1.00 0.97 1.00

2.2 Matriz de covariâncias combinada

\[ \hat{V}_{COMB}=(M-1)^{-1}[(M-1)\hat{V}_1+...+(m_g-1)\hat{V}_g] \tag{2}\]

Calculando o valor de m para cada subgrupo e sua soma:

(m.grupo1 <- nrow(grupo1))

[1] 5

(m.grupo2 <- nrow(grupo2))

[1] 5

(m.grupo3 <- nrow(grupo3))

[1] 5

(m <- m.grupo1+ m.grupo2+m.grupo3)

[1] 15

Covariância combinada:

(cov.comb <- (m.grupo1-1)*cov1 +
   (m.grupo2-1)*cov2 + (m.grupo3-1)*cov3 / (m-2))

         Sem1      Sem3      Sem4      Sem5     Sem6      Sem7
Sem1 5445.385  5934.246  3715.985  5882.092  5273.20  6134.477
Sem3 5934.246 13899.754 10639.523 15557.385 12675.06 16513.492
Sem4 3715.985 10639.523  9679.662 13303.123 13547.31 14314.862
Sem5 5882.092 15557.385 13303.123 23220.954 20044.37 23511.169
Sem6 5273.200 12675.062 13547.308 20044.369 29844.95 25991.523
Sem7 6134.477 16513.492 14314.862 23511.169 25991.52 28918.985

Correlação combinada:

(cor.comb <- cov2cor(cov.comb))

          Sem1      Sem3      Sem4      Sem5      Sem6      Sem7
Sem1 1.0000000 0.6820995 0.5118345 0.5230913 0.4136419 0.4888456
Sem3 0.6820995 1.0000000 0.9172517 0.8659504 0.6223161 0.8236522
Sem4 0.5118345 0.9172517 1.0000000 0.8873266 0.7970535 0.8555897
Sem5 0.5230913 0.8659504 0.8873266 1.0000000 0.7614071 0.9072828
Sem6 0.4136419 0.6223161 0.7970535 0.7614071 1.0000000 0.8847178
Sem7 0.4888456 0.8236522 0.8555897 0.9072828 0.8847178 1.0000000

Nota

Essa parte não é pedida, mas foi feita para fins didáticos!

3. Matriz de gráficos de dispersão

Médias para os 3 grupos de porquinhos (1, 2 e 3):

(media.grupo1 <- apply(grupo1[, 3:8],2, mean))

 Sem1  Sem3  Sem4  Sem5  Sem6  Sem7 
466.4 519.4 568.8 561.6 546.6 572.0

(media.grupo2 <- apply(grupo2[, 3:8],2, mean))

 Sem1  Sem3  Sem4  Sem5  Sem6  Sem7 
494.4 551.0 574.2 567.0 603.0 644.0

(media.grupo3 <- apply(grupo3[, 3:8],2, mean))

 Sem1  Sem3  Sem4  Sem5  Sem6  Sem7 
497.8 534.6 579.8 571.8 588.2 623.2

Desvios padrões para os 3 grupos de porquinhos (1, 2 e 3):

(desvio.grupo1 <- apply(grupo1[, 3:8],2, sd))

    Sem1     Sem3     Sem4     Sem5     Sem6     Sem7 
16.72722 40.64234 39.58788 42.84040 66.87900 61.81828

(desvio.grupo2 <- apply(grupo2[, 3:8],2, sd))

    Sem1     Sem3     Sem4     Sem5     Sem6     Sem7 
31.91081 41.89272 27.99464 62.06045 53.30572 57.54998

(desvio.grupo3 <- apply(grupo3[, 3:8],2, sd))

    Sem1     Sem3     Sem4     Sem5     Sem6     Sem7 
28.67403 29.76239 29.95330 39.23901 43.70583 35.37231

Padronização com scale() (mostrando a primeira linha de cada um dos grupos):

grupo1.pdr <- scale(grupo1[,3:8], center = media.grupo1, scale = desvio.grupo1)
grupo2.pdr <- scale(grupo2[,3:8], center = media.grupo2, scale = desvio.grupo2)
grupo3.pdr <- scale(grupo3[,3:8], center = media.grupo3, scale = desvio.grupo3)
head(grupo1.pdr, 1);head(grupo2.pdr, 1);head(grupo3.pdr, 1)

           Sem1     Sem3      Sem4      Sem5      Sem6      Sem7
[1,] -0.6815238 -1.46153 -1.485303 -1.344525 -1.653733 -1.714703

          Sem1      Sem3       Sem4       Sem5       Sem6       Sem7
[1,] 0.6142119 0.2148345 -0.3286343 -0.6928728 -0.9567453 -0.8166815

            Sem1     Sem3    Sem4     Sem5     Sem6     Sem7
[1,] -0.06277457 0.853426 1.40886 1.279339 1.002155 1.323069

3.1 A matriz de dispersão

rotulo <- c("Semana 1", "Semana 3", "Semana 4", "Semana 5", "Semana 6", "Semana 7")
df <- grupo1.pdr
pairs(df, labels = rotulo, main = "Grupo 1",
      pch = 19, # Pch symbol
      col = "cyan",  # Color
      # Title
      gap = 0,           # Subplots distance
      # Diagonal direction
      cex.labels = 0.8,  # Size of diagonal texts
      font.labels = 1)

rotulo <- c("Semana 1", "Semana 3", "Semana 4", "Semana 5", "Semana 6", "Semana 7")
df <- grupo2.pdr
pairs(df, labels = rotulo, main = "Grupo 2",
      pch = 19, # Pch symbol
      col = "mediumpurple",  # Color
      # Title
      gap = 0,           # Subplots distance
      # Diagonal direction
      cex.labels = 0.8,  # Size of diagonal texts
      font.labels = 1)

rotulo <- c("Semana 1", "Semana 3", "Semana 4", "Semana 5", "Semana 6", "Semana 7")
df <- grupo3.pdr
pairs(df, labels = rotulo, main = "Grupo 3",
      pch = 19, # Pch symbol
      col = "mediumspringgreen",  # Color
      # Title
      gap = 0,           # Subplots distance
      # Diagonal direction
      cex.labels = 0.8,  # Size of diagonal texts
      font.labels = 1)