a)Criação da matriz

# Criação da matriz
minhaMat <- matrix(c(
  6, 112, 5, 545,
  34, 113, 9, 546,
  923, 114, 34, 547,
  5, 115, 76, 548,
  0, 116, 2, 549
), nrow = 5, byrow = TRUE)

# Exibindo a matriz
minhaMat
##      [,1] [,2] [,3] [,4]
## [1,]    6  112    5  545
## [2,]   34  113    9  546
## [3,]  923  114   34  547
## [4,]    5  115   76  548
## [5,]    0  116    2  549

b)Média de cada linha

# Média de cada linha
medias_linhas <- apply(minhaMat, 1, mean)
medias_linhas
## [1] 167.00 175.50 404.50 186.00 166.75

c)Média de cada coluna

# Média de cada coluna
medias_colunas <- apply(minhaMat, 2, mean)
medias_colunas
## [1] 193.6 114.0  25.2 547.0

d)Ordenação das colunas em ordem ascendente

# Ordenação das colunas
minhaMat_ordenada <- apply(minhaMat, 2, sort)
minhaMat_ordenada
##      [,1] [,2] [,3] [,4]
## [1,]    0  112    2  545
## [2,]    5  113    5  546
## [3,]    6  114    9  547
## [4,]   34  115   34  548
## [5,]  923  116   76  549

e) Operação módulo da divisão por 10

# Operação módulo por 10
minhaMat_modulo <- apply(minhaMat, c(1, 2), function(x) x %% 10)
minhaMat_modulo
##      [,1] [,2] [,3] [,4]
## [1,]    6    2    5    5
## [2,]    4    3    9    6
## [3,]    3    4    4    7
## [4,]    5    5    6    8
## [5,]    0    6    2    9

2a) Use três funções da família apply para obter o mínimo de cada coluna

# Carregar o conjunto de dados mtcars
data(mtcars)

# 2a. Use três funções da família apply para obter o mínimo de cada coluna
l <- lapply(mtcars, min)  # Retorna uma lista
s <- sapply(mtcars, min)  # Retorna um vetor
m <- apply(mtcars, 2, min)  # Retorna um vetor

# Mostrar as saídas

print(l)
## $mpg
## [1] 10.4
## 
## $cyl
## [1] 4
## 
## $disp
## [1] 71.1
## 
## $hp
## [1] 52
## 
## $drat
## [1] 2.76
## 
## $wt
## [1] 1.513
## 
## $qsec
## [1] 14.5
## 
## $vs
## [1] 0
## 
## $am
## [1] 0
## 
## $gear
## [1] 3
## 
## $carb
## [1] 1
print(s)
##    mpg    cyl   disp     hp   drat     wt   qsec     vs     am   gear   carb 
## 10.400  4.000 71.100 52.000  2.760  1.513 14.500  0.000  0.000  3.000  1.000
print(m)
##    mpg    cyl   disp     hp   drat     wt   qsec     vs     am   gear   carb 
## 10.400  4.000 71.100 52.000  2.760  1.513 14.500  0.000  0.000  3.000  1.000

b) Coloque os três objetos l, s e m na lista lista.objetos

lista.objetos <- list(lapply_output = l, sapply_output = s, apply_output = m)

c) Use uma função apply adequada para obter a classe de cada elemento na lista

classes <- sapply(lista.objetos, class)

print("Classes dos elementos na lista:")
## [1] "Classes dos elementos na lista:"
print(classes)
## lapply_output sapply_output  apply_output 
##        "list"     "numeric"     "numeric"

d)Qual a classe da saída de cada uma das três funções usadas no exercício?

cat("Classe de lapply:", class(l), "\n")
## Classe de lapply: list
cat("Classe de sapply:", class(s), "\n")
## Classe de sapply: numeric
cat("Classe de apply:", class(m), "\n")
## Classe de apply: numeric

e)Repetir o exercício usando estruturas de controle

# Função para calcular o mínimo usando loops
minimo_por_coluna <- function(data) {
  resultado <- numeric(ncol(data))
  for (i in 1:ncol(data)) {
    resultado[i] <- min(data[[i]])
  }
  return(resultado)
}
# Comparar tempos entre estruturas de controle e família apply
tempo_loop <- system.time({
  resultado_loop <- minimo_por_coluna(mtcars)
})

tempo_apply <- system.time({
  resultado_apply <- apply(mtcars, 2, min)
})

cat("Tempo usando loops:", tempo_loop["elapsed"], "segundos\n")
## Tempo usando loops: 0 segundos
cat("Tempo usando apply:", tempo_apply["elapsed"], "segundos\n")
## Tempo usando apply: 0 segundos
# Comparação de resultados
print("Resultados do loop:")
## [1] "Resultados do loop:"
print(resultado_loop)
##  [1] 10.400  4.000 71.100 52.000  2.760  1.513 14.500  0.000  0.000  3.000
## [11]  1.000
print("Resultados do apply:")
## [1] "Resultados do apply:"
print(resultado_apply)
##    mpg    cyl   disp     hp   drat     wt   qsec     vs     am   gear   carb 
## 10.400  4.000 71.100 52.000  2.760  1.513 14.500  0.000  0.000  3.000  1.000

3a)Usar mapply para criar uma lista de 10 elementos

# Cada elemento da lista contém um número decrescente de caracteres repetidos
lista_mapply <- mapply(rep, LETTERS[1:10], 10:1, SIMPLIFY = FALSE)
# Mostrar a saída
print("Lista criada com mapply:")
## [1] "Lista criada com mapply:"
print(lista_mapply)
## $A
##  [1] "A" "A" "A" "A" "A" "A" "A" "A" "A" "A"
## 
## $B
## [1] "B" "B" "B" "B" "B" "B" "B" "B" "B"
## 
## $C
## [1] "C" "C" "C" "C" "C" "C" "C" "C"
## 
## $D
## [1] "D" "D" "D" "D" "D" "D" "D"
## 
## $E
## [1] "E" "E" "E" "E" "E" "E"
## 
## $F
## [1] "F" "F" "F" "F" "F"
## 
## $G
## [1] "G" "G" "G" "G"
## 
## $H
## [1] "H" "H" "H"
## 
## $I
## [1] "I" "I"
## 
## $J
## [1] "J"

b) Ajustar a função para adicionar nomes a cada elemento da lista usando USE.NAMES

# O nome será "Elemento X", onde X é o número do elemento
lista_mapply_nomes <- mapply(rep, LETTERS[1:10], 10:1, SIMPLIFY = FALSE, 
                              USE.NAMES = TRUE)

# Adicionar nomes explicitamente
names(lista_mapply_nomes) <- paste0("Elemento ", seq_along(lista_mapply_nomes))

print("Lista com nomes ajustados:")
## [1] "Lista com nomes ajustados:"
print(lista_mapply_nomes)
## $`Elemento 1`
##  [1] "A" "A" "A" "A" "A" "A" "A" "A" "A" "A"
## 
## $`Elemento 2`
## [1] "B" "B" "B" "B" "B" "B" "B" "B" "B"
## 
## $`Elemento 3`
## [1] "C" "C" "C" "C" "C" "C" "C" "C"
## 
## $`Elemento 4`
## [1] "D" "D" "D" "D" "D" "D" "D"
## 
## $`Elemento 5`
## [1] "E" "E" "E" "E" "E" "E"
## 
## $`Elemento 6`
## [1] "F" "F" "F" "F" "F"
## 
## $`Elemento 7`
## [1] "G" "G" "G" "G"
## 
## $`Elemento 8`
## [1] "H" "H" "H"
## 
## $`Elemento 9`
## [1] "I" "I"
## 
## $`Elemento 10`
## [1] "J"

c) Repetir o exercício usando estruturas de controle

criar_lista_loops <- function() {
  lista_loops <- list()
  for (i in 1:10) {
    lista_loops[[i]] <- rep(LETTERS[i], 11 - i)
  }
  # Adicionar nomes aos elementos
  names(lista_loops) <- paste0("Elemento ", seq_along(lista_loops))
  return(lista_loops)
}

# Comparação de tempo entre as duas abordagens
tempo_mapply <- system.time({
  lista_mapply <- mapply(rep, LETTERS[1:10], 10:1, SIMPLIFY = FALSE)
})

tempo_loops <- system.time({
  lista_loops <- criar_lista_loops()
})

# Comparar os tempos
cat("Tempo usando mapply:", tempo_mapply["elapsed"], "segundos\n")
## Tempo usando mapply: 0 segundos
cat("Tempo usando loops:", tempo_loops["elapsed"], "segundos\n")
## Tempo usando loops: 0.02 segundos
# Mostrar resultados
print("Lista criada com mapply:")
## [1] "Lista criada com mapply:"
print(lista_mapply)
## $A
##  [1] "A" "A" "A" "A" "A" "A" "A" "A" "A" "A"
## 
## $B
## [1] "B" "B" "B" "B" "B" "B" "B" "B" "B"
## 
## $C
## [1] "C" "C" "C" "C" "C" "C" "C" "C"
## 
## $D
## [1] "D" "D" "D" "D" "D" "D" "D"
## 
## $E
## [1] "E" "E" "E" "E" "E" "E"
## 
## $F
## [1] "F" "F" "F" "F" "F"
## 
## $G
## [1] "G" "G" "G" "G"
## 
## $H
## [1] "H" "H" "H"
## 
## $I
## [1] "I" "I"
## 
## $J
## [1] "J"
print("Lista criada com loops:")
## [1] "Lista criada com loops:"
print(lista_loops)
## $`Elemento 1`
##  [1] "A" "A" "A" "A" "A" "A" "A" "A" "A" "A"
## 
## $`Elemento 2`
## [1] "B" "B" "B" "B" "B" "B" "B" "B" "B"
## 
## $`Elemento 3`
## [1] "C" "C" "C" "C" "C" "C" "C" "C"
## 
## $`Elemento 4`
## [1] "D" "D" "D" "D" "D" "D" "D"
## 
## $`Elemento 5`
## [1] "E" "E" "E" "E" "E" "E"
## 
## $`Elemento 6`
## [1] "F" "F" "F" "F" "F"
## 
## $`Elemento 7`
## [1] "G" "G" "G" "G"
## 
## $`Elemento 8`
## [1] "H" "H" "H"
## 
## $`Elemento 9`
## [1] "I" "I"
## 
## $`Elemento 10`
## [1] "J"
# Comparar os resultados para verificar se são iguais
cat("As listas criadas são iguais:", identical(lista_mapply, lista_loops), "\n")
## As listas criadas são iguais: FALSE

4a)

# Carregar o conjunto de dados Titanic
data("Titanic")

# Ver a estrutura do conjunto de dados
print("Estrutura do conjunto de dados Titanic:")
## [1] "Estrutura do conjunto de dados Titanic:"
str(Titanic)
##  'table' num [1:4, 1:2, 1:2, 1:2] 0 0 35 0 0 0 17 0 118 154 ...
##  - attr(*, "dimnames")=List of 4
##   ..$ Class   : chr [1:4] "1st" "2nd" "3rd" "Crew"
##   ..$ Sex     : chr [1:2] "Male" "Female"
##   ..$ Age     : chr [1:2] "Child" "Adult"
##   ..$ Survived: chr [1:2] "No" "Yes"
# Ver a tabela
print("Tabela de dados Titanic:")
## [1] "Tabela de dados Titanic:"
print(Titanic)
## , , Age = Child, Survived = No
## 
##       Sex
## Class  Male Female
##   1st     0      0
##   2nd     0      0
##   3rd    35     17
##   Crew    0      0
## 
## , , Age = Adult, Survived = No
## 
##       Sex
## Class  Male Female
##   1st   118      4
##   2nd   154     13
##   3rd   387     89
##   Crew  670      3
## 
## , , Age = Child, Survived = Yes
## 
##       Sex
## Class  Male Female
##   1st     5      1
##   2nd    11     13
##   3rd    13     14
##   Crew    0      0
## 
## , , Age = Adult, Survived = Yes
## 
##       Sex
## Class  Male Female
##   1st    57    140
##   2nd    14     80
##   3rd    75     76
##   Crew  192     20
# Soma de homens e mulheres a bordo
soma_homens_mulheres <- apply(Titanic, MARGIN = 2, function(x) sum(x["Male"], x["Female"]))
print("Soma de homens e mulheres a bordo:")
## [1] "Soma de homens e mulheres a bordo:"
print(soma_homens_mulheres)
##   Male Female 
##     NA     NA

b) Tabela com a soma de sobreviventes pela variável Sex

# Soma de sobreviventes pela variável Sex
sobreviventes_por_sexo <- apply(Titanic[, , , "Yes"], MARGIN = 1, sum)
print("Soma de sobreviventes por sexo:")
## [1] "Soma de sobreviventes por sexo:"
print(sobreviventes_por_sexo)
##  1st  2nd  3rd Crew 
##  203  118  178  212

c) Tabela com a quantidade de passageiros pelas variáveis Sex e Age

# Quantidade de passageiros pelas variáveis Sex e Age
passageiros_sexo_idade <- apply(Titanic, MARGIN = c(2, 3), sum)
print("Quantidade de passageiros por sexo e idade:")
## [1] "Quantidade de passageiros por sexo e idade:"
print(passageiros_sexo_idade)
##         Age
## Sex      Child Adult
##   Male      64  1667
##   Female    45   425

d)Repetir usando estruturas de controle e comparar o tempo

# Função para somar homens e mulheres a bordo (parte a)
soma_homens_mulheres_loop <- function() {
  homens <- sum(Titanic["Male", , , ])
  mulheres <- sum(Titanic["Female", , , ])
  return(c(Male = homens, Female = mulheres))
}

# Função para somar sobreviventes por sexo (parte b)
sobreviventes_por_sexo_loop <- function() {
  sobreviventes_male <- sum(Titanic["Male", , , "Yes"])
  sobreviventes_female <- sum(Titanic["Female", , , "Yes"])
  return(c(Male = sobreviventes_male, Female = sobreviventes_female))
}

# Função para quantidade de passageiros por sexo e idade (parte c)
passageiros_sexo_idade_loop <- function() {
  resultados <- matrix(0, nrow = 2, ncol = 2)
  rownames(resultados) <- c("Male", "Female")
  colnames(resultados) <- c("Child", "Adult")
  
  for (sexo in c("Male", "Female")) {
    for (idade in c("Child", "Adult")) {
      resultados[sexo, idade] <- sum(Titanic[sexo, idade, , ])
    }
  }
  return(resultados)
}

5a) Criação da lista de matrizes

primeira <- matrix(38:66, nrow = 3)
## Warning in matrix(38:66, nrow = 3): data length [29] is not a sub-multiple or
## multiple of the number of rows [3]
segunda <- matrix(56:91, nrow = 3)
terceira <- matrix(82:145, nrow = 3)
## Warning in matrix(82:145, nrow = 3): data length [64] is not a sub-multiple or
## multiple of the number of rows [3]
quarta <- matrix(46:93, nrow = 5)
## Warning in matrix(46:93, nrow = 5): data length [48] is not a sub-multiple or
## multiple of the number of rows [5]
lista.obj <- list(primeira, segunda, terceira, quarta)

print(lista.obj)
## [[1]]
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,]   38   41   44   47   50   53   56   59   62    65
## [2,]   39   42   45   48   51   54   57   60   63    66
## [3,]   40   43   46   49   52   55   58   61   64    38
## 
## [[2]]
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
## [1,]   56   59   62   65   68   71   74   77   80    83    86    89
## [2,]   57   60   63   66   69   72   75   78   81    84    87    90
## [3,]   58   61   64   67   70   73   76   79   82    85    88    91
## 
## [[3]]
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,]   82   85   88   91   94   97  100  103  106   109   112   115   118   121
## [2,]   83   86   89   92   95   98  101  104  107   110   113   116   119   122
## [3,]   84   87   90   93   96   99  102  105  108   111   114   117   120   123
##      [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22]
## [1,]   124   127   130   133   136   139   142   145
## [2,]   125   128   131   134   137   140   143    82
## [3,]   126   129   132   135   138   141   144    83
## 
## [[4]]
##      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,]   46   51   56   61   66   71   76   81   86    91
## [2,]   47   52   57   62   67   72   77   82   87    92
## [3,]   48   53   58   63   68   73   78   83   88    93
## [4,]   49   54   59   64   69   74   79   84   89    46
## [5,]   50   55   60   65   70   75   80   85   90    47

b)Extração da segunda coluna de cada matriz usando lapply

segunda_coluna_lapply <- lapply(lista.obj, function(mat) mat[, 2])

print(segunda_coluna_lapply)
## [[1]]
## [1] 41 42 43
## 
## [[2]]
## [1] 59 60 61
## 
## [[3]]
## [1] 85 86 87
## 
## [[4]]
## [1] 51 52 53 54 55

c)Extração da terceira linha de cada matriz usando lapply

terceira_linha_lapply <- lapply(lista.obj, function(mat) mat[3, ])

print(terceira_linha_lapply)
## [[1]]
##  [1] 40 43 46 49 52 55 58 61 64 38
## 
## [[2]]
##  [1] 58 61 64 67 70 73 76 79 82 85 88 91
## 
## [[3]]
##  [1]  84  87  90  93  96  99 102 105 108 111 114 117 120 123 126 129 132 135 138
## [20] 141 144  83
## 
## [[4]]
##  [1] 48 53 58 63 68 73 78 83 88 93

d)Estruturas de controle para extração

segunda_coluna_loop <- function(lista) {
  resultado <- list()
  for (i in seq_along(lista)) {
    resultado[[i]] <- lista[[i]][, 2]
  }
  return(resultado)
}

terceira_linha_loop <- function(lista) {
  resultado <- list()
  for (i in seq_along(lista)) {
    resultado[[i]] <- lista[[i]][3, ]
  }
  return(resultado)
}

# Comparação de tempos entre lapply e estruturas de controle
tempo_lapply_segunda <- system.time({
  segunda_coluna_lapply
})
tempo_loop_segunda <- system.time({
  segunda_coluna_loop(lista.obj)
})

tempo_lapply_terceira <- system.time({
  terceira_linha_lapply
})
tempo_loop_terceira <- system.time({
  terceira_linha_loop(lista.obj)
})

# Resultados com mais casas decimais
cat("Segunda coluna:\n")
## Segunda coluna:
cat("Tempo usando lapply:", sprintf("%.10f", tempo_lapply_segunda["elapsed"]), "segundos\n")
## Tempo usando lapply: 0.0000000000 segundos
cat("Tempo usando loop:", sprintf("%.10f", tempo_loop_segunda["elapsed"]), "segundos\n\n")
## Tempo usando loop: 0.0200000000 segundos
cat("Terceira linha:\n")
## Terceira linha:
cat("Tempo usando lapply:", sprintf("%.10f", tempo_lapply_terceira["elapsed"]), "segundos\n")
## Tempo usando lapply: 0.0000000000 segundos
cat("Tempo usando loop:", sprintf("%.10f", tempo_loop_terceira["elapsed"]), "segundos\n")
## Tempo usando loop: 0.0000000000 segundos

6a)Box-plot de cada variável quantitativa, estratificada por Species

# Gerar box-plots com apply
par(mfrow = c(2, 2))  # Dividir o espaço gráfico em uma matriz 2x2
apply(iris[, -5], 2, function(x) {
  boxplot(x ~ iris$Species, 
          main = deparse(substitute(x)),
          ylab = "Valores",
          xlab = "Espécies",
          col = c("#0072B2", "#E69F00", "#009E73"))  # Azul, laranja, verde
})

## $Sepal.Length
## $Sepal.Length$stats
##      [,1] [,2] [,3]
## [1,]  4.3  4.9  5.6
## [2,]  4.8  5.6  6.2
## [3,]  5.0  5.9  6.5
## [4,]  5.2  6.3  6.9
## [5,]  5.8  7.0  7.9
## 
## $Sepal.Length$n
## [1] 50 50 50
## 
## $Sepal.Length$conf
##          [,1]     [,2]     [,3]
## [1,] 4.910622 5.743588 6.343588
## [2,] 5.089378 6.056412 6.656412
## 
## $Sepal.Length$out
## [1] 4.9
## 
## $Sepal.Length$group
## [1] 3
## 
## $Sepal.Length$names
## [1] "setosa"     "versicolor" "virginica" 
## 
## 
## $Sepal.Width
## $Sepal.Width$stats
##      [,1] [,2] [,3]
## [1,]  2.9  2.0  2.2
## [2,]  3.2  2.5  2.8
## [3,]  3.4  2.8  3.0
## [4,]  3.7  3.0  3.2
## [5,]  4.4  3.4  3.8
## 
## $Sepal.Width$n
## [1] 50 50 50
## 
## $Sepal.Width$conf
##          [,1]     [,2]     [,3]
## [1,] 3.288277 2.688277 2.910622
## [2,] 3.511723 2.911723 3.089378
## 
## $Sepal.Width$out
## [1] 2.3
## 
## $Sepal.Width$group
## [1] 1
## 
## $Sepal.Width$names
## [1] "setosa"     "versicolor" "virginica" 
## 
## 
## $Petal.Length
## $Petal.Length$stats
##      [,1] [,2] [,3]
## [1,]  1.1 3.30 4.50
## [2,]  1.4 4.00 5.10
## [3,]  1.5 4.35 5.55
## [4,]  1.6 4.60 5.90
## [5,]  1.9 5.10 6.90
## 
## $Petal.Length$n
## [1] 50 50 50
## 
## $Petal.Length$conf
##          [,1]     [,2]     [,3]
## [1,] 1.455311 4.215933 5.371243
## [2,] 1.544689 4.484067 5.728757
## 
## $Petal.Length$out
## [1] 1 3
## 
## $Petal.Length$group
## [1] 1 2
## 
## $Petal.Length$names
## [1] "setosa"     "versicolor" "virginica" 
## 
## 
## $Petal.Width
## $Petal.Width$stats
##      [,1] [,2] [,3]
## [1,]  0.1  1.0  1.4
## [2,]  0.2  1.2  1.8
## [3,]  0.2  1.3  2.0
## [4,]  0.3  1.5  2.3
## [5,]  0.4  1.8  2.5
## 
## $Petal.Width$n
## [1] 50 50 50
## 
## $Petal.Width$conf
##           [,1]     [,2]     [,3]
## [1,] 0.1776554 1.232966 1.888277
## [2,] 0.2223446 1.367034 2.111723
## 
## $Petal.Width$out
## [1] 0.5 0.6
## 
## $Petal.Width$group
## [1] 1 1
## 
## $Petal.Width$names
## [1] "setosa"     "versicolor" "virginica"

b)

if (!requireNamespace("vioplot", quietly = TRUE)) {
  install.packages("vioplot")
}
library(vioplot)
## Warning: package 'vioplot' was built under R version 4.4.2
## Loading required package: sm
## Warning: package 'sm' was built under R version 4.4.2
## Package 'sm', version 2.2-6.0: type help(sm) for summary information
## Loading required package: zoo
## Warning: package 'zoo' was built under R version 4.4.2
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
# Gerar violin plots com apply
par(mfrow = c(2, 2))
apply(iris[, -5], 2, function(x) {
  vioplot(split(x, iris$Species), 
          col = "salmon",  
          names = rep("", 3),  # Remover números no eixo x
          main = deparse(substitute(x)),
          ylab = "Valores")
})

## $Sepal.Length
## $Sepal.Length$upper
## [1] 5.8 7.0 7.9
## 
## $Sepal.Length$lower
## [1] 4.3000 4.9000 5.2125
## 
## $Sepal.Length$median
## [1] 5.0 5.9 6.5
## 
## $Sepal.Length$q1
## [1] 4.800 5.600 6.225
## 
## $Sepal.Length$q3
## [1] 5.2 6.3 6.9
## 
## 
## $Sepal.Width
## $Sepal.Width$upper
## [1] 4.3875 3.4000 3.7375
## 
## $Sepal.Width$lower
## [1] 2.4875 2.0000 2.2375
## 
## $Sepal.Width$median
## [1] 3.4 2.8 3.0
## 
## $Sepal.Width$q1
## [1] 3.200 2.525 2.800
## 
## $Sepal.Width$q3
## [1] 3.675 3.000 3.175
## 
## 
## $Petal.Length
## $Petal.Length$upper
## [1] 1.8375 5.1000 6.9000
## 
## $Petal.Length$lower
## [1] 1.1375 3.1000 4.5000
## 
## $Petal.Length$median
## [1] 1.50 4.35 5.55
## 
## $Petal.Length$q1
## [1] 1.4 4.0 5.1
## 
## $Petal.Length$q3
## [1] 1.575 4.600 5.875
## 
## 
## $Petal.Width
## $Petal.Width$upper
## [1] 0.45 1.80 2.50
## 
## $Petal.Width$lower
## [1] 0.1 1.0 1.4
## 
## $Petal.Width$median
## [1] 0.2 1.3 2.0
## 
## $Petal.Width$q1
## [1] 0.2 1.2 1.8
## 
## $Petal.Width$q3
## [1] 0.3 1.5 2.3

c)

# Gerar violin plots com loop
par(mfrow = c(2, 2))
for (i in 1:4) {
  vioplot(split(iris[, i], iris$Species), 
          col = "salmon", 
          names = rep("", 3),  # Remover números no eixo x
          main = colnames(iris)[i],
          ylab = "Valores")
}

# Medir tempo com apply
tempo_apply_boxplot <- system.time({
  apply(iris[, -5], 2, function(x) {
    boxplot(x ~ iris$Species, 
            col = c("#0072B2", "#E69F00", "#009E73"))
  })
})

tempo_apply_violin <- system.time({
  apply(iris[, -5], 2, function(x) {
    vioplot(split(x, iris$Species), col = "salmon")
  })
})

# Medir tempo com loop
tempo_loop_boxplot <- system.time({
  for (i in 1:4) {
    boxplot(iris[, i] ~ iris$Species, 
            col = c("#0072B2", "#E69F00", "#009E73"))
  }
})

tempo_loop_violin <- system.time({
  for (i in 1:4) {
    vioplot(split(iris[, i], iris$Species), col = "salmon")
  }
})

# Exibir tempos com precisão
cat("Tempo com apply - Boxplot:", sprintf("%.10f", tempo_apply_boxplot["elapsed"]), "segundos\n")
## Tempo com apply - Boxplot: 0.0700000000 segundos
cat("Tempo com loop - Boxplot:", sprintf("%.10f", tempo_loop_boxplot["elapsed"]), "segundos\n\n")
## Tempo com loop - Boxplot: 0.0600000000 segundos
cat("Tempo com apply - Violin:", sprintf("%.10f", tempo_apply_violin["elapsed"]), "segundos\n")
## Tempo com apply - Violin: 0.1400000000 segundos
cat("Tempo com loop - Violin:", sprintf("%.10f", tempo_loop_violin["elapsed"]), "segundos\n")
## Tempo com loop - Violin: 0.1300000000 segundos

7a) Descubra qual das variáveis do conjunto de dados iris não é numérica

# Verificar se as variáveis são numéricas
sapply(iris, is.numeric)
## Sepal.Length  Sepal.Width Petal.Length  Petal.Width      Species 
##         TRUE         TRUE         TRUE         TRUE        FALSE

b) Identifique os níveis desse fator (utilize a função levels)

# Identificar os níveis do fator 'Species'
levels(iris$Species)
## [1] "setosa"     "versicolor" "virginica"

c)função unique e compare a saída.

# Identificar os valores únicos de 'Species'
unique(iris$Species)
## [1] setosa     versicolor virginica 
## Levels: setosa versicolor virginica

d) Repita o item (a) usando estruturas de controle. Compare o tempo entre as duas abordagens (Estruturas de controle e família apply).

# Usando estruturas de controle
numeric_vars <- c()
for (col in colnames(iris)) {
  if (is.numeric(iris[[col]])) {
    numeric_vars <- c(numeric_vars, col)
  }
}
print(numeric_vars)
## [1] "Sepal.Length" "Sepal.Width"  "Petal.Length" "Petal.Width"
# Usando a família apply
system.time({
  sapply(iris, is.numeric)
})
##    user  system elapsed 
##       0       0       0
# Usando estruturas de controle
system.time({
  numeric_vars <- c()
  for (col in colnames(iris)) {
    if (is.numeric(iris[[col]])) {
      numeric_vars <- c(numeric_vars, col)
    }
  }
})
##    user  system elapsed 
##    0.01    0.00    0.02

8a) Quais são as colunas de classe não numérica?

# Carregar o pacote ggplot2
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.4.1
# Verificar se diamonds está disponível
head(diamonds)
## # A tibble: 6 × 10
##   carat cut       color clarity depth table price     x     y     z
##   <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1  0.23 Ideal     E     SI2      61.5    55   326  3.95  3.98  2.43
## 2  0.21 Premium   E     SI1      59.8    61   326  3.89  3.84  2.31
## 3  0.23 Good      E     VS1      56.9    65   327  4.05  4.07  2.31
## 4  0.29 Premium   I     VS2      62.4    58   334  4.2   4.23  2.63
## 5  0.31 Good      J     SI2      63.3    58   335  4.34  4.35  2.75
## 6  0.24 Very Good J     VVS2     62.8    57   336  3.94  3.96  2.48
# Verificar se as variáveis são numéricas
sapply(diamonds, is.numeric)
##   carat     cut   color clarity   depth   table   price       x       y       z 
##    TRUE   FALSE   FALSE   FALSE    TRUE    TRUE    TRUE    TRUE    TRUE    TRUE

b) Obtenha a média das colunas 8, 9 e 10 das observações 10000 a 11000

# Obter a média das colunas 8, 9 e 10 para as observações 10000 a 11000
mean_values <- colMeans(diamonds[10000:11000, 8:10])
mean_values
##        x        y        z 
## 6.237852 6.233506 3.851049

c) Repita (b), arredondando para um dígito.

# Obter a média e arredondar para um dígito
mean_values_rounded <- round(mean_values, 1)
mean_values_rounded
##   x   y   z 
## 6.2 6.2 3.9

d)Ordene os resultados arredondados em ordem crescente.

# Ordenar os valores arredondados em ordem crescente
sorted_mean_values <- sort(mean_values_rounded)
sorted_mean_values
##   z   x   y 
## 3.9 6.2 6.2

e)Repita o exercício usando estruturas de controle. Compare o tempo entre as duas abordagens

# Usando estruturas de controle
mean_values_control <- c()
for (i in 8:10) {
  mean_values_control[i-7] <- mean(diamonds[10000:11000, i])
}
## Warning in mean.default(diamonds[10000:11000, i]): argument is not numeric or
## logical: returning NA
## Warning in mean.default(diamonds[10000:11000, i]): argument is not numeric or
## logical: returning NA
## Warning in mean.default(diamonds[10000:11000, i]): argument is not numeric or
## logical: returning NA
mean_values_control
## [1] NA NA NA
# Arredondando os resultados
mean_values_control_rounded <- round(mean_values_control, 1)
mean_values_control_rounded
## [1] NA NA NA
# Ordenando os resultados
sorted_mean_values_control <- sort(mean_values_control_rounded)
sorted_mean_values_control
## numeric(0)
# Usando a família apply
system.time({
  mean_values_apply <- colMeans(diamonds[10000:11000, 8:10])
  mean_values_apply_rounded <- round(mean_values_apply, 1)
  sorted_mean_values_apply <- sort(mean_values_apply_rounded)
})
##    user  system elapsed 
##       0       0       0
# Usando estruturas de controle
system.time({
  mean_values_control <- c()
  for (i in 8:10) {
    mean_values_control[i-7] <- mean(diamonds[10000:11000, i])
  }
  mean_values_control_rounded <- round(mean_values_control, 1)
  sorted_mean_values_control <- sort(mean_values_control_rounded)
})
## Warning in mean.default(diamonds[10000:11000, i]): argument is not numeric or
## logical: returning NA
## Warning in mean.default(diamonds[10000:11000, i]): argument is not numeric or
## logical: returning NA
## Warning in mean.default(diamonds[10000:11000, i]): argument is not numeric or
## logical: returning NA
##    user  system elapsed 
##       0       0       0

9a) Calcule a mediana de cada coluna ordenada pelo número de carburadores.

# Calcular a mediana de cada coluna ordenada pelo número de carburadores
aggregate(mtcars[, -1], by = list(mtcars$carb), FUN = median)
##   Group.1 cyl   disp  hp  drat    wt   qsec  vs am gear carb
## 1       1   4 108.00  93 3.850 2.320 19.470 1.0  1  4.0    1
## 2       2   4 143.75 111 3.730 3.170 17.175 0.5  0  4.0    2
## 3       3   8 275.80 180 3.070 3.780 17.600 0.0  0  3.0    3
## 4       4   8 350.50 210 3.815 3.505 17.220 0.0  0  3.5    4
## 5       6   6 145.00 175 3.620 2.770 15.500 0.0  1  5.0    6
## 6       8   8 301.00 335 3.540 3.570 14.600 0.0  1  5.0    8

b) Repita o item (a), usando a notação ‘formula’ como argumento.

# Usar notação 'formula' para calcular a mediana
aggregate(. ~ carb, data = mtcars, FUN = median)
##   carb   mpg cyl   disp  hp  drat    wt   qsec  vs am gear
## 1    1 22.80   4 108.00  93 3.850 2.320 19.470 1.0  1  4.0
## 2    2 22.10   4 143.75 111 3.730 3.170 17.175 0.5  0  4.0
## 3    3 16.40   8 275.80 180 3.070 3.780 17.600 0.0  0  3.0
## 4    4 15.25   8 350.50 210 3.815 3.505 17.220 0.0  0  3.5
## 5    6 19.70   6 145.00 175 3.620 2.770 15.500 0.0  1  5.0
## 6    8 15.00   8 301.00 335 3.540 3.570 14.600 0.0  1  5.0

d) Repita o item (a), usando estruturas de controle. Compare o tempo entre as duas abordagens

# Usar estruturas de controle para calcular a mediana agrupada por 'carb'
carb_groups <- unique(mtcars$carb)
medians_by_carb <- data.frame(carb = carb_groups)

for (carb_value in carb_groups) {
  group_data <- mtcars[mtcars$carb == carb_value, -1]
  medians_by_carb[medians_by_carb$carb == carb_value, -1] <- apply(group_data, 2, median)
}
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
medians_by_carb
##   carb
## 1    4
## 2    1
## 3    2
## 4    3
## 5    6
## 6    8
# Usando aggregate
system.time({
  aggregate(mtcars[, -1], by = list(mtcars$carb), FUN = median)
})
##    user  system elapsed 
##       0       0       0
# Usando estruturas de controle
system.time({
  carb_groups <- unique(mtcars$carb)
  medians_by_carb <- data.frame(carb = carb_groups)
  
  for (carb_value in carb_groups) {
    group_data <- mtcars[mtcars$carb == carb_value, -1]
    medians_by_carb[medians_by_carb$carb == carb_value, -1] <- apply(group_data, 2, median)
  }
  medians_by_carb
})
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
## Warning in matrix(value, n, p): non-empty data for zero-extent matrix
##    user  system elapsed 
##    0.01    0.00    0.01

10)Calcular o produto de uma matriz

# Criar a matriz X (107x2) e o vetor y (107)
set.seed(42)
X <- matrix(rnorm(107 * 2), nrow = 107, ncol = 2)
y <- rnorm(107)

# Verificar dimensões
dim(X)
## [1] 107   2
length(y)
## [1] 107
# Usar multiplicação de matrizes
system.time({
  result1 <- t(X) %*% y
})
##    user  system elapsed 
##       0       0       0
# Usar crossprod
system.time({
  result2 <- crossprod(X, y)
})
##    user  system elapsed 
##       0       0       0