Capítulo 8 Outra maneira de fazer loop
8.1 Vamos dar uma olhada na família apply
Assista este conteúdo em Cap_7_Apply family no PVANet
Antes de começar vamos dar uma olhada na família apply.
Esta família pertence ao grupos de funções básicas do R e guarda um conjunto de funções que facilitam muito nossa vida, principalmente quando precisamos fazer loops e não queremos utilizar os métodos apresentados anteriormente.
Entre os irmãos da família temos apply, lapply, sapply, mapply e rep. Temos também os parentes Sweep e aggregate.
Em se tratando dos irmãos, cada um trabalha com uma estrutura de dados diferente ( vector, matrix, list e etc)
Dito isto, para iniciarmos o conteúdo de multivariada precisaremos instalar alguns pacotes. Vejam como foi feita a instalação e o carregamento dos pacotes.
pacotes<-c("datasets","cluster", "factoextra", "vegan", "analogue")
#lapply(pacotes, install.packages, character.only = TRUE)
lapply(pacotes, library, character.only = TRUE)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa## [[1]]
## [1] "webr" "mosaic" "mosaicData" "ggformula" "Matrix"
## [6] "lsr" "modeest" "rmarkdown" "ggpubr" "lubridate"
## [11] "forcats" "stringr" "dplyr" "readr" "tidyr"
## [16] "tibble" "tidyverse" "viridis" "viridisLite" "unikn"
## [21] "RColorBrewer" "analogue" "vegan" "lattice" "permute"
## [26] "flow" "purrr" "magrittr" "ggplot2" "stats"
## [31] "graphics" "grDevices" "utils" "datasets" "methods"
## [36] "base"
##
## [[2]]
## [1] "cluster" "webr" "mosaic" "mosaicData" "ggformula"
## [6] "Matrix" "lsr" "modeest" "rmarkdown" "ggpubr"
## [11] "lubridate" "forcats" "stringr" "dplyr" "readr"
## [16] "tidyr" "tibble" "tidyverse" "viridis" "viridisLite"
## [21] "unikn" "RColorBrewer" "analogue" "vegan" "lattice"
## [26] "permute" "flow" "purrr" "magrittr" "ggplot2"
## [31] "stats" "graphics" "grDevices" "utils" "datasets"
## [36] "methods" "base"
##
## [[3]]
## [1] "factoextra" "cluster" "webr" "mosaic" "mosaicData"
## [6] "ggformula" "Matrix" "lsr" "modeest" "rmarkdown"
## [11] "ggpubr" "lubridate" "forcats" "stringr" "dplyr"
## [16] "readr" "tidyr" "tibble" "tidyverse" "viridis"
## [21] "viridisLite" "unikn" "RColorBrewer" "analogue" "vegan"
## [26] "lattice" "permute" "flow" "purrr" "magrittr"
## [31] "ggplot2" "stats" "graphics" "grDevices" "utils"
## [36] "datasets" "methods" "base"
##
## [[4]]
## [1] "factoextra" "cluster" "webr" "mosaic" "mosaicData"
## [6] "ggformula" "Matrix" "lsr" "modeest" "rmarkdown"
## [11] "ggpubr" "lubridate" "forcats" "stringr" "dplyr"
## [16] "readr" "tidyr" "tibble" "tidyverse" "viridis"
## [21] "viridisLite" "unikn" "RColorBrewer" "analogue" "vegan"
## [26] "lattice" "permute" "flow" "purrr" "magrittr"
## [31] "ggplot2" "stats" "graphics" "grDevices" "utils"
## [36] "datasets" "methods" "base"
##
## [[5]]
## [1] "factoextra" "cluster" "webr" "mosaic" "mosaicData"
## [6] "ggformula" "Matrix" "lsr" "modeest" "rmarkdown"
## [11] "ggpubr" "lubridate" "forcats" "stringr" "dplyr"
## [16] "readr" "tidyr" "tibble" "tidyverse" "viridis"
## [21] "viridisLite" "unikn" "RColorBrewer" "analogue" "vegan"
## [26] "lattice" "permute" "flow" "purrr" "magrittr"
## [31] "ggplot2" "stats" "graphics" "grDevices" "utils"
## [36] "datasets" "methods" "base"Foi criado um um objeto vector com os nomes do pacotes que precisamos. Em seguida, iniciamos com lapply que fazer um loop dentro do objeto que foi criado (pacotes) depois vem o comando que quero que seja executado (install.packages) seguindo de um definição lógica (character.only = TRUE) onde que indica que o que tem dentro de pacotes é character.
Atenção! character.only = TRUE não está relacionado com lapply, mas com instalação ou carregamento de pacotes Para mais dealhes clique aqui.
Vamos observar uns exemplos mais completos seguindo as sugestões de Perlin (2018).
8.1.1 lapply
Com lapply a entrada é uma lista e a saída também é um lista. Esta função vai fazer um loop dentro de cada elemento da lista e retornar o resultado em forma de lista.
Abaixo vamos criar uma lista com 3 vetores e calcular a média de cada vetor utilizando lapply.
lista.1 <- list(vec1 = 33:47, vec2 = seq(115,157,by=3), vec3 = seq(10,by=-8.5, length.out=15))
typeof(lista.1)## [1] "list"lista.1.mean <- lapply(X = lista.1, FUN = mean) # print result
typeof(lista.1.mean)## [1] "list"lista.1.mean## $vec1
## [1] 40
##
## $vec2
## [1] 136
##
## $vec3
## [1] -49.5Também é possível combinar com argumento por exemplo na.rm = TRUE.
lista.2 <- list( c( 33:40, NA, 50), c( 2:5, NA), 10:-109)
lista.2.mean <- lapply(X = lista.1, FUN = mean, na.rm = TRUE)
lista.2.mean## $vec1
## [1] 40
##
## $vec2
## [1] 136
##
## $vec3
## [1] -49.5função para gerar arquivos
setwd(““J:/ENG 792/ENG_792-AVDR/ENG.792-AVDR”)
criar.arquivo <- function(nome.arquivo, N = 100){
if (class(nome.arquivo)!="character"){stop("ERRO: Nome não é caractere!")}
if (!( class(N) %in% c("numeric","integer"))){stop("ERRO: N não é integer ou numeric!")}
temp.df <- data.frame(x = runif(N))
write.csv(x = temp.df, file = nome.arquivo)
return(TRUE)
}
n.files <- 5
pattern.name <- 'meus_arquivos_com_lapply_'
out.dir <- 'muitos arquivos/'
file.names <- paste0(out.dir, pattern.name, seq(1, n.files), '. csv')
if(!dir.exists(out.dir)){dir.create(out.dir)}
file.remove(list.files(out.dir, full.names = TRUE)) ## [1] TRUE TRUE TRUE TRUE TRUEsaida.l <- lapply(X = file.names, FUN = criar.arquivo, N = 100)
saida.l## [[1]]
## [1] TRUE
##
## [[2]]
## [1] TRUE
##
## [[3]]
## [1] TRUE
##
## [[4]]
## [1] TRUE
##
## [[5]]
## [1] TRUE8.1.2 sapply
Funciona de maneira semelhante ao lapply mas tentando simplificar a saída. Veja que no exemplo abaixo a saída é um vetor numérico.
lista.3 <- list(vec1 = 33:47, vec2 = seq(115,157,by=3), vec3 = seq(10,by=-8.5, length.out=15))
is.list(lista.3);is.vector(lista.3)## [1] TRUE## [1] TRUElista.3.vec <- sapply(lista.3, mean)
class(lista.3.vec);is.list(lista.3.vec);is.vector(lista.3.vec)## [1] "numeric"## [1] FALSE## [1] TRUElista.3.vec## vec1 vec2 vec3
## 40.0 136.0 -49.5Criando um função para testar se a lista.4 é numeric e integer.
lista.4 <- list( runif(10), runif(15), rnorm(1000))
my.fct <- function( x){
if (!(class(x)%in%c("numeric","integer")))
{stop("ERRO: Class de x não é numeric ou integer.") }
x <- na.omit(x)
out <- c(mean(x),sd(x))
return(out)
} Utilizando a função criada com sapply.
lista.4.vec <- sapply(lista.4, my.fct) # check result
class(lista.4.vec)## [1] "matrix" "array"lista.4.vec## [,1] [,2] [,3]
## [1,] 0.3956025 0.7014711 -0.03105341
## [2,] 0.3011568 0.2377516 0.976475188.1.3 tapply
Função utilizada para cálculos em grupos (factor) de dados individualmente permitindo a criação de amostras para então aplicar os cáculos necessários.
Abaixo temos o cálculode média para cada grupo A, B e C.
meu.vetor <- 1:150
factor.1 <- factor(c(rep("C", 50), rep("B", 50), rep("A", 50)))
factor.1.mean.vec <- tapply(X = meu.vetor, INDEX = factor.1, FUN = mean)
print(factor.1.mean.vec)## A B C
## 125.5 75.5 25.5Abaixo o operador %in% é utilizado para identificar se um parâmetro pertence a um tipo de restrição definida.
Abaixo quero saber se a classe de x não é numeric ou integer. Se for vai omitir os valores NA e calcular a média, valor máximo e mínimo.
descr.vec <- function(x){
if (!(class(x)%in%c('numeric','integer'))){stop(' ERROR: Class de x não é numeric ou integer.') }
x <- na.omit(x)
out <- c(
mean = mean(x),
max = max(x),
min = min(x))
return( out)}Temos aqui a função do.call que permite aplicar uma função a toda uma lista.
| Ozone | Solar.R | Wind | Temp | Month | Day |
|---|---|---|---|---|---|
| 41 | 190 | 7.4 | 67 | 5 | 1 |
| 36 | 118 | 8.0 | 72 | 5 | 2 |
| 12 | 149 | 12.6 | 74 | 5 | 3 |
| 18 | 313 | 11.5 | 62 | 5 | 4 |
| NA | NA | 14.3 | 56 | 5 | 5 |
| 28 | NA | 14.9 | 66 | 5 | 6 |
| 23 | 299 | 8.6 | 65 | 5 | 7 |
| 19 | 99 | 13.8 | 59 | 5 | 8 |
| 8 | 19 | 20.1 | 61 | 5 | 9 |
| NA | 194 | 8.6 | 69 | 5 | 10 |
| 7 | NA | 6.9 | 74 | 5 | 11 |
| 16 | 256 | 9.7 | 69 | 5 | 12 |
| 11 | 290 | 9.2 | 66 | 5 | 13 |
| 14 | 274 | 10.9 | 68 | 5 | 14 |
| 18 | 65 | 13.2 | 58 | 5 | 15 |
| 14 | 334 | 11.5 | 64 | 5 | 16 |
| 34 | 307 | 12.0 | 66 | 5 | 17 |
| 6 | 78 | 18.4 | 57 | 5 | 18 |
| 30 | 322 | 11.5 | 68 | 5 | 19 |
| 11 | 44 | 9.7 | 62 | 5 | 20 |
| 1 | 8 | 9.7 | 59 | 5 | 21 |
| 11 | 320 | 16.6 | 73 | 5 | 22 |
| 4 | 25 | 9.7 | 61 | 5 | 23 |
| 32 | 92 | 12.0 | 61 | 5 | 24 |
| NA | 66 | 16.6 | 57 | 5 | 25 |
| NA | 266 | 14.9 | 58 | 5 | 26 |
| NA | NA | 8.0 | 57 | 5 | 27 |
| 23 | 13 | 12.0 | 67 | 5 | 28 |
| 45 | 252 | 14.9 | 81 | 5 | 29 |
| 115 | 223 | 5.7 | 79 | 5 | 30 |
| 37 | 279 | 7.4 | 76 | 5 | 31 |
| NA | 286 | 8.6 | 78 | 6 | 1 |
| NA | 287 | 9.7 | 74 | 6 | 2 |
| NA | 242 | 16.1 | 67 | 6 | 3 |
| NA | 186 | 9.2 | 84 | 6 | 4 |
| NA | 220 | 8.6 | 85 | 6 | 5 |
| NA | 264 | 14.3 | 79 | 6 | 6 |
| 29 | 127 | 9.7 | 82 | 6 | 7 |
| NA | 273 | 6.9 | 87 | 6 | 8 |
| 71 | 291 | 13.8 | 90 | 6 | 9 |
| 39 | 323 | 11.5 | 87 | 6 | 10 |
| NA | 259 | 10.9 | 93 | 6 | 11 |
| NA | 250 | 9.2 | 92 | 6 | 12 |
| 23 | 148 | 8.0 | 82 | 6 | 13 |
| NA | 332 | 13.8 | 80 | 6 | 14 |
| NA | 322 | 11.5 | 79 | 6 | 15 |
| 21 | 191 | 14.9 | 77 | 6 | 16 |
| 37 | 284 | 20.7 | 72 | 6 | 17 |
| 20 | 37 | 9.2 | 65 | 6 | 18 |
| 12 | 120 | 11.5 | 73 | 6 | 19 |
| 13 | 137 | 10.3 | 76 | 6 | 20 |
| NA | 150 | 6.3 | 77 | 6 | 21 |
| NA | 59 | 1.7 | 76 | 6 | 22 |
| NA | 91 | 4.6 | 76 | 6 | 23 |
| NA | 250 | 6.3 | 76 | 6 | 24 |
| NA | 135 | 8.0 | 75 | 6 | 25 |
| NA | 127 | 8.0 | 78 | 6 | 26 |
| NA | 47 | 10.3 | 73 | 6 | 27 |
| NA | 98 | 11.5 | 80 | 6 | 28 |
| NA | 31 | 14.9 | 77 | 6 | 29 |
| NA | 138 | 8.0 | 83 | 6 | 30 |
| 135 | 269 | 4.1 | 84 | 7 | 1 |
| 49 | 248 | 9.2 | 85 | 7 | 2 |
| 32 | 236 | 9.2 | 81 | 7 | 3 |
| NA | 101 | 10.9 | 84 | 7 | 4 |
| 64 | 175 | 4.6 | 83 | 7 | 5 |
| 40 | 314 | 10.9 | 83 | 7 | 6 |
| 77 | 276 | 5.1 | 88 | 7 | 7 |
| 97 | 267 | 6.3 | 92 | 7 | 8 |
| 97 | 272 | 5.7 | 92 | 7 | 9 |
| 85 | 175 | 7.4 | 89 | 7 | 10 |
| NA | 139 | 8.6 | 82 | 7 | 11 |
| 10 | 264 | 14.3 | 73 | 7 | 12 |
| 27 | 175 | 14.9 | 81 | 7 | 13 |
| NA | 291 | 14.9 | 91 | 7 | 14 |
| 7 | 48 | 14.3 | 80 | 7 | 15 |
| 48 | 260 | 6.9 | 81 | 7 | 16 |
| 35 | 274 | 10.3 | 82 | 7 | 17 |
| 61 | 285 | 6.3 | 84 | 7 | 18 |
| 79 | 187 | 5.1 | 87 | 7 | 19 |
| 63 | 220 | 11.5 | 85 | 7 | 20 |
| 16 | 7 | 6.9 | 74 | 7 | 21 |
| NA | 258 | 9.7 | 81 | 7 | 22 |
| NA | 295 | 11.5 | 82 | 7 | 23 |
| 80 | 294 | 8.6 | 86 | 7 | 24 |
| 108 | 223 | 8.0 | 85 | 7 | 25 |
| 20 | 81 | 8.6 | 82 | 7 | 26 |
| 52 | 82 | 12.0 | 86 | 7 | 27 |
| 82 | 213 | 7.4 | 88 | 7 | 28 |
| 50 | 275 | 7.4 | 86 | 7 | 29 |
| 64 | 253 | 7.4 | 83 | 7 | 30 |
| 59 | 254 | 9.2 | 81 | 7 | 31 |
| 39 | 83 | 6.9 | 81 | 8 | 1 |
| 9 | 24 | 13.8 | 81 | 8 | 2 |
| 16 | 77 | 7.4 | 82 | 8 | 3 |
| 78 | NA | 6.9 | 86 | 8 | 4 |
| 35 | NA | 7.4 | 85 | 8 | 5 |
| 66 | NA | 4.6 | 87 | 8 | 6 |
| 122 | 255 | 4.0 | 89 | 8 | 7 |
| 89 | 229 | 10.3 | 90 | 8 | 8 |
| 110 | 207 | 8.0 | 90 | 8 | 9 |
| NA | 222 | 8.6 | 92 | 8 | 10 |
| NA | 137 | 11.5 | 86 | 8 | 11 |
| 44 | 192 | 11.5 | 86 | 8 | 12 |
| 28 | 273 | 11.5 | 82 | 8 | 13 |
| 65 | 157 | 9.7 | 80 | 8 | 14 |
| NA | 64 | 11.5 | 79 | 8 | 15 |
| 22 | 71 | 10.3 | 77 | 8 | 16 |
| 59 | 51 | 6.3 | 79 | 8 | 17 |
| 23 | 115 | 7.4 | 76 | 8 | 18 |
| 31 | 244 | 10.9 | 78 | 8 | 19 |
| 44 | 190 | 10.3 | 78 | 8 | 20 |
| 21 | 259 | 15.5 | 77 | 8 | 21 |
| 9 | 36 | 14.3 | 72 | 8 | 22 |
| NA | 255 | 12.6 | 75 | 8 | 23 |
| 45 | 212 | 9.7 | 79 | 8 | 24 |
| 168 | 238 | 3.4 | 81 | 8 | 25 |
| 73 | 215 | 8.0 | 86 | 8 | 26 |
| NA | 153 | 5.7 | 88 | 8 | 27 |
| 76 | 203 | 9.7 | 97 | 8 | 28 |
| 118 | 225 | 2.3 | 94 | 8 | 29 |
| 84 | 237 | 6.3 | 96 | 8 | 30 |
| 85 | 188 | 6.3 | 94 | 8 | 31 |
| 96 | 167 | 6.9 | 91 | 9 | 1 |
| 78 | 197 | 5.1 | 92 | 9 | 2 |
| 73 | 183 | 2.8 | 93 | 9 | 3 |
| 91 | 189 | 4.6 | 93 | 9 | 4 |
| 47 | 95 | 7.4 | 87 | 9 | 5 |
| 32 | 92 | 15.5 | 84 | 9 | 6 |
| 20 | 252 | 10.9 | 80 | 9 | 7 |
| 23 | 220 | 10.3 | 78 | 9 | 8 |
| 21 | 230 | 10.9 | 75 | 9 | 9 |
| 24 | 259 | 9.7 | 73 | 9 | 10 |
| 44 | 236 | 14.9 | 81 | 9 | 11 |
| 21 | 259 | 15.5 | 76 | 9 | 12 |
| 28 | 238 | 6.3 | 77 | 9 | 13 |
| 9 | 24 | 10.9 | 71 | 9 | 14 |
| 13 | 112 | 11.5 | 71 | 9 | 15 |
| 46 | 237 | 6.9 | 78 | 9 | 16 |
| 18 | 224 | 13.8 | 67 | 9 | 17 |
| 13 | 27 | 10.3 | 76 | 9 | 18 |
| 24 | 238 | 10.3 | 68 | 9 | 19 |
| 16 | 201 | 8.0 | 82 | 9 | 20 |
| 13 | 238 | 12.6 | 64 | 9 | 21 |
| 23 | 14 | 9.2 | 71 | 9 | 22 |
| 36 | 139 | 10.3 | 81 | 9 | 23 |
| 7 | 49 | 10.3 | 69 | 9 | 24 |
| 14 | 20 | 16.6 | 63 | 9 | 25 |
| 30 | 193 | 6.9 | 70 | 9 | 26 |
| NA | 145 | 13.2 | 77 | 9 | 27 |
| 14 | 191 | 14.3 | 75 | 9 | 28 |
| 18 | 131 | 8.0 | 76 | 9 | 29 |
| 20 | 223 | 11.5 | 68 | 9 | 30 |
## $`5`
## mean max min
## 65.54839 81.00000 56.00000
##
## $`6`
## mean max min
## 79.1 93.0 65.0
##
## $`7`
## mean max min
## 83.90323 92.00000 73.00000
##
## $`8`
## mean max min
## 83.96774 97.00000 72.00000
##
## $`9`
## mean max min
## 76.9 93.0 63.0## mean max min
## 5 65.54839 81 56
## 6 79.10000 93 65
## 7 83.90323 92 73
## 8 83.96774 97 72
## 9 76.90000 93 638.1.4 mapply
Esta função pode ser utilizada numa lista de múltiplas listas ou vários vetores.
Abaixo vamos criar uma lista de 10 vetores de tamanhos diferentes.
N <- 10 # Prealocando a lista
minha.lista <- list()
for (i in seq(1,N)){
minha.lista[[i]]<-seq(1,i)}
minha.lista## [[1]]
## [1] 1
##
## [[2]]
## [1] 1 2
##
## [[3]]
## [1] 1 2 3
##
## [[4]]
## [1] 1 2 3 4
##
## [[5]]
## [1] 1 2 3 4 5
##
## [[6]]
## [1] 1 2 3 4 5 6
##
## [[7]]
## [1] 1 2 3 4 5 6 7
##
## [[8]]
## [1] 1 2 3 4 5 6 7 8
##
## [[9]]
## [1] 1 2 3 4 5 6 7 8 9
##
## [[10]]
## [1] 1 2 3 4 5 6 7 8 9 10Aqui fazemos a mesma coisa utilizando o mapply.
minha.lista <- mapply(FUN = seq, rep(1,N), seq(1,N))
print(minha.lista)## [[1]]
## [1] 1
##
## [[2]]
## [1] 1 2
##
## [[3]]
## [1] 1 2 3
##
## [[4]]
## [1] 1 2 3 4
##
## [[5]]
## [1] 1 2 3 4 5
##
## [[6]]
## [1] 1 2 3 4 5 6
##
## [[7]]
## [1] 1 2 3 4 5 6 7
##
## [[8]]
## [1] 1 2 3 4 5 6 7 8
##
## [[9]]
## [1] 1 2 3 4 5 6 7 8 9
##
## [[10]]
## [1] 1 2 3 4 5 6 7 8 9 108.1.5 apply
Utilizado em arrays.
minha.matriz <- matrix( 1: 15, nrow = 5)
minha.matriz## [,1] [,2] [,3]
## [1,] 1 6 11
## [2,] 2 7 12
## [3,] 3 8 13
## [4,] 4 9 14
## [5,] 5 10 15soma.linha <- apply( X = minha.matriz, MARGIN = 1, FUN=sum)
soma.linha## [1] 18 21 24 27 30soma.coluna <- apply( X = minha.matriz, MARGIN = 2, FUN = sum)
soma.coluna## [1] 15 40 65# mostra os valores máximos por linha
print(apply(X = minha.matriz, MARGIN = 1, FUN = max))## [1] 11 12 13 14 15# mostra os valores máximos por coluna
print(apply( X = minha.matriz, MARGIN = 2, FUN = max))## [1] 5 10 15